0a93d90367cd6e46ca268d021670594a70a88390
1
module ParasitemiaUI.GUI
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.
18 open ParasitemiaCore.Config
19 open ParasitemiaCore.Utils
22 let run (defaultConfig
: Config) (fileToOpen
: string option) =
23 let app = new Application()
24 let win = Views.MainWindow()
26 let state = State.State(defaultConfig
)
27 let mutable currentScale = 1.
28 let mutable displayHealthy = false
29 let warningBelowNumberOfRBC = 1000
32 let canvasCurrentImageColor = win.canvasCurrentImage
.Background
33 win.menuHightlightRBC
.IsChecked <- displayHealthy
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))))
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
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
59 setRBCFrameStyle srcImg rbc frame
60 frame
.border
.StrokeThickness <- 1.
61 frame
.txtRBCNumber
.Text <- rbc.num
.ToString()
64 let updateDocumentStatus () =
65 win.txtDocumentStatus
.Text <- if state.FilePath = "" then "<New document>" else state.FilePath
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()
75 let highlightRBCFrame (frame
: Views.RBCFrame) (highlight
: bool) =
76 let rbc = frame
.Tag :?> RBC
78 frame
.border
.StrokeThickness <- 3.
79 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then frame
.Opacity <- 1.
81 frame
.border
.StrokeThickness <- 1.
82 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then frame
.Opacity <- 0.
84 let zoomToRBC (rbc : RBC) =
85 win.scrollViewCurrentImage
.ScrollToHorizontalOffset(rbc.center
.X * currentScale - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
86 win.scrollViewCurrentImage
.ScrollToVerticalOffset(rbc.center
.Y * currentScale - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
89 let txtImageName_TextChanged =
90 TextChangedEventHandler(fun obj args
-> state.CurrentImage |> Option.iter
(fun srcImg -> state.SetName srcImg win.txtImageName
.Text))
92 let updateCurrentImageInformation () =
93 win.txtImageName
.TextChanged.RemoveHandler(txtImageName_TextChanged)
94 win.txtImageInformation1
.Inlines.Clear()
95 win.txtImageInformation2
.Inlines.Clear()
96 win.txtImageName
.Text <- ""
98 match state.CurrentImage with
100 win.gridImageInformation
.Visibility <- Visibility.Visible
101 win.txtImageName
.Text <- srcImg.name
102 win.txtImageName
.TextChanged.AddHandler(txtImageName_TextChanged)
105 let parasitemiaStr = Utils.percentText
(state.ImageParasitemia srcImg)
106 win.txtImageInformation1
.Inlines.Add(Documents.Run("Parasitemia: ", FontWeight = FontWeights.Bold))
107 win.txtImageInformation1
.Inlines.Add(parasitemiaStr)
108 win.txtImageInformation1
.Inlines.Add(Documents.LineBreak())
110 win.txtImageInformation1
.Inlines.Add(Documents.Run("Last analysis: ", FontWeight = FontWeights.Bold))
111 win.txtImageInformation1
.Inlines.Add(Documents.Run(if srcImg.dateLastAnalysis
.Ticks = 0L then "<Never>" else srcImg.dateLastAnalysis
.ToLocalTime().ToString()))
113 // The right part part.
114 win.txtImageInformation2
.Inlines.Add(Documents.Run("Added infected erythrocyte: ", FontWeight = FontWeights.Bold))
115 win.txtImageInformation2
.Inlines.Add(Documents.Run((state.ImageNbManuallyChangedRBCStr srcImg true) + " " + (state.ImageManuallyChangedRBCStr srcImg true)))
116 win.txtImageInformation2
.Inlines.Add(Documents.LineBreak())
117 win.txtImageInformation2
.Inlines.Add(Documents.Run("Removed infected erythrocyte: ", FontWeight = FontWeights.Bold))
118 win.txtImageInformation2
.Inlines.Add(Documents.Run((state.ImageNbManuallyChangedRBCStr srcImg false) + " " + (state.ImageManuallyChangedRBCStr srcImg false)))
121 win.gridImageInformation
.Visibility <- Visibility.Hidden
123 let updateGlobalParasitemia () =
124 win.txtGlobalParasitemia
.Inlines.Clear()
125 let total, infected
= state.GlobalParasitemia
126 win.txtGlobalParasitemia
.Inlines.Add(Documents.Run(Utils.percentText
(total, infected
), FontWeight = FontWeights.Bold))
127 if total > 0 && total < warningBelowNumberOfRBC then
128 win.txtGlobalParasitemia
.Inlines.Add(
130 sprintf
" Warning: the number of erythrocytes should be above %d" warningBelowNumberOfRBC,
131 FontWeight = FontWeights.Bold,
132 Foreground = Brushes.Red
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
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)
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.
152 preview
.viewport
.Margin <-
160 preview
.viewport
.Visibility <- Visibility.Hidden
162 let rec setAsInfected
(srcImg : SourceImage) (rbc : RBC) (infected
: bool) =
163 state.SetAsInfected rbc infected
164 win.canvasCurrentImage
.Children
165 |> Seq.cast
<Views.RBCFrame>
168 if (frame
.Tag :?> RBC) = rbc then
169 setRBCFrameStyle srcImg rbc frame
171 updateRBCFramesPreview
()
172 updateCurrentImageInformation ()
173 updateGlobalParasitemia ()
175 and RBCFrame (srcImg : SourceImage) (rbc : RBC) : Views.RBCFrame =
176 let frame = RBCFrameFromExisting srcImg rbc (Views.RBCFrame())
177 frame.SetValue(Panel.ZIndexProperty, Int32.MaxValue - rbc.num
) // To be sure the
178 frame.menuRBCSetAsHealthy
.Click.AddHandler(fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) false)
179 frame.menuRBCSetAsInfected
.Click.AddHandler(fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) true)
180 frame.ContextMenuOpening.AddHandler(
182 if (frame.Tag :?> RBC).infected
then
183 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Visible
184 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Collapsed
186 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Collapsed
187 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Visible
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)
194 and updateRBCFramesPreview
() =
195 match state.CurrentImage with
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 then
201 RBCFrameFromExisting srcImg rbc (win.stackRBC
.Children.[currentPreview] :?> Views.RBCFrame)
203 let f = RBCFrame srcImg rbc
204 f.MouseLeftButtonUp.AddHandler(fun obj args
-> zoomToRBC (f.Tag :?> RBC))
205 win.stackRBC
.Children.Add(f) |> ignore
208 currentPreview <- currentPreview + 1
210 previewInfected.Height <- win.stackRBC
.ActualHeight
211 previewInfected.Width <- win.stackRBC
.ActualHeight * rbc.size
.Width / rbc.size
.Height
212 previewInfected.border
.Fill <- ImageBrush(BitmapSourceConvert.ToBitmapSource(extractRBCPreview srcImg.img
rbc))
214 win.stackRBC
.Children.RemoveRange(currentPreview, win.stackRBC
.Children.Count - currentPreview)
217 updateViewportPreview ()
219 let updateRBCFramesCurrent () =
220 match state.CurrentImage with
222 let mutable currentCanvas = 0
223 for rbc in srcImg.rbcs
do
225 if currentCanvas < win.canvasCurrentImage
.Children.Count then
226 RBCFrameFromExisting srcImg rbc (win.canvasCurrentImage
.Children.[currentCanvas] :?> Views.RBCFrame)
228 let f = RBCFrame srcImg rbc
229 win.canvasCurrentImage
.Children.Add(f) |> ignore
232 currentCanvas <- currentCanvas + 1
234 Canvas.SetLeft(frame, rbc.center
.X - rbc.size
.Width / 2.)
235 Canvas.SetTop(frame, rbc.center
.Y - rbc.size
.Height / 2.)
237 for i
in currentCanvas .. win.canvasCurrentImage
.Children.Count - 1 do
238 win.canvasCurrentImage
.Children.[i
].Visibility <- Visibility.Hidden
241 let askDocumentPathToSave () : string option =
242 let dialog = SaveFileDialog(AddExtension = true, DefaultExt = PiaZ.extension
, Filter = PiaZ.filter
)
244 if state.FilePath <> "" then
245 dialog.FileName <- FileInfo(state.FilePath).Name
246 elif
state.PatientID <> "" then
247 dialog.FileName <- state.PatientID + PiaZ.extension
249 let res = dialog.ShowDialog()
250 if res.HasValue && res.Value then
255 let saveCurrentDocument () =
257 if state.FilePath = "" then
258 match askDocumentPathToSave () with
260 state.FilePath <- filepath
265 updateDocumentStatus ()
266 displayStatusMessage "Document saved"
268 | :? IOException as ex ->
269 Log.Error(ex.ToString())
270 MessageBox.Show(sprintf
"The document cannot be save in \"%s\"" state.FilePath, "Error saving the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
272 let saveCurrentDocumentAsNewFile () =
273 match askDocumentPathToSave () with
275 state.FilePath <- filepath
276 saveCurrentDocument ()
279 // Ask the use to save the current document if neccessary.
280 let askSaveCurrent () =
281 if state.AlteredSinceLastSave then
282 match MessageBox.Show("Would you like to save the current document?", "Saving the current document", MessageBoxButton.YesNo, MessageBoxImage.Question) with
283 | MessageBoxResult.Yes -> saveCurrentDocument ()
286 let updateCurrentImage () =
287 match state.CurrentImage with
289 win.imgLogos
.Visibility <- Visibility.Collapsed
291 // Highlight the preview.
292 win.stackPreviews
.Children
293 |> Seq.cast
<Views.ImageSourcePreview>
294 |> Seq.iter
(fun preview
-> preview
.border
.BorderThickness <- Thickness(if preview
.Tag = (srcImg :> Object) then 3. else 0.))
296 win.canvasCurrentImage
.Height <- float srcImg.img
.Height
297 win.canvasCurrentImage
.Width <- float srcImg.img
.Width
298 win.canvasCurrentImage
.Background <- ImageBrush(BitmapSourceConvert.ToBitmapSource(srcImg.img
))
300 updateRBCFramesCurrent ()
301 updateRBCFramesPreview
()
304 win.imgLogos
.Visibility <- Visibility.Visible
306 win.stackRBC
.Children.Clear()
307 win.canvasCurrentImage
.Children.Clear()
308 win.canvasCurrentImage
.Background <- canvasCurrentImageColor
310 updateCurrentImageInformation ()
312 let setCurrentImage (srcImg : SourceImage) =
313 if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg then
314 state.CurrentImage <- Some srcImg
315 updateCurrentImage ()
317 let addPreview (srcImg : SourceImage) =
318 let imgCtrl = Views.ImageSourcePreview(Margin = Thickness(3.))
320 imgCtrl.menuRemoveImage
.Click.AddHandler(fun obj args
->
321 win.stackPreviews
.Children.Remove(imgCtrl)
322 let srcImg = imgCtrl.Tag :?> SourceImage
323 let currentRemoved = Some srcImg = state.CurrentImage
324 state.RemoveSourceImage srcImg
325 if currentRemoved then
328 updateGlobalParasitemia()
330 // Update image numbers.
331 win.stackPreviews
.Children |> Seq.cast
<Views.ImageSourcePreview> |> Seq.iter
(fun imgPreview
-> imgPreview
.txtImageNumber
.Text <- (imgPreview
.Tag :?> SourceImage).num
.ToString()))
333 imgCtrl.Tag <- srcImg
334 imgCtrl.txtImageNumber
.Text <- srcImg.num
.ToString()
336 let height = srcImg.img
.Height * width / srcImg.img
.Width
337 imgCtrl.imagePreview
.Source <- BitmapSourceConvert.ToBitmapSource(srcImg.img
.Resize(width, height, Emgu.CV.CvEnum.Inter.Cubic))
338 win.stackPreviews
.Children.Add(imgCtrl) |> ignore
340 // Zoom to a mouse position into the control 'imgCtrl'.
341 let zoomTo (mousePos
: Point) =
342 let canvasW = win.canvasCurrentImage
.ActualWidth * currentScale
343 let canvasH = win.canvasCurrentImage
.ActualHeight * currentScale
344 let centerX = (mousePos
.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
345 let centerY = (mousePos
.Y - imgCtrl.BorderThickness.Top) / (imgCtrl.ActualHeight - imgCtrl.BorderThickness.Top) * canvasH
346 win.scrollViewCurrentImage
.ScrollToHorizontalOffset(centerX - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
347 win.scrollViewCurrentImage
.ScrollToVerticalOffset(centerY - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
349 imgCtrl.MouseLeftButtonDown.AddHandler(fun obj args
->
350 setCurrentImage (state.SourceImages |> Seq.find
(fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
351 imgCtrl.UpdateLayout()
352 zoomTo (args
.GetPosition(imgCtrl))
353 imgCtrl.CaptureMouse() |> ignore
356 imgCtrl.MouseMove.AddHandler(fun obj args
->
357 if imgCtrl.IsMouseCaptured then
358 zoomTo (args
.GetPosition(imgCtrl))
361 imgCtrl.MouseLeftButtonUp.AddHandler(fun obj args
->
362 if imgCtrl.IsMouseCaptured then
363 imgCtrl.ReleaseMouseCapture()
366 let updatePreviews () =
367 win.stackPreviews
.Children.Clear ()
368 for srcImg in state.SourceImages do
370 updateCurrentImage ()
373 win.txtPatient
.Text <- state.PatientID
375 updateGlobalParasitemia ()
376 updateDocumentStatus ()
378 let loadFile (filepath
: string) =
380 let previousFilePath = state.FilePath
382 state.FilePath <- filepath
386 | :? IOException as ex ->
387 Log.Error(ex.ToString())
388 state.FilePath <- previousFilePath
389 MessageBox.Show(sprintf
"The document cannot be loaded from \"%s\"" filepath
, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
392 let dialog = OpenFileDialog(Filter = PiaZ.filter
)
393 let res = dialog.ShowDialog()
394 if res.HasValue && res.Value then
395 loadFile dialog.FileName
402 let exportResults () =
403 let extension = ".txt"
404 let dialog = SaveFileDialog(AddExtension = true, DefaultExt = extension)
406 if state.FilePath <> "" then
407 dialog.FileName <- Path.GetFileNameWithoutExtension(state.FilePath) + extension
408 elif
state.PatientID <> "" then
409 dialog.FileName <- state.PatientID + extension
411 let res = dialog.ShowDialog()
412 if res.HasValue && res.Value then
414 Export.exportResults state dialog.FileName
416 | :? IOException as ex ->
417 Log.Error(ex.ToString())
418 MessageBox.Show(sprintf
"The results cannot be exported in \"%s\"" state.FilePath, "Error exporting the files", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
421 let dialog = OpenFileDialog(Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
422 let res = dialog.ShowDialog()
423 if res.HasValue && res.Value then
424 let noSourceImage = state.SourceImages.Count() = 0
426 for filename
in dialog.FileNames do
428 let srcImg = state.AddSourceImage filename defaultConfig
432 Log.Error(ex.ToString())
433 MessageBox.Show(sprintf
"Unable to read the image from \"%s\"" filename, "Error adding an image", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
435 updateGlobalParasitemia ()
437 if noSourceImage then
438 updateCurrentImage ()
440 let showAnalysisWindow () =
441 if Analysis.showWindow
win state then
442 updateGlobalParasitemia ()
443 updateCurrentImage ()
445 let setHighlightRBC (highlight
: bool) =
446 displayHealthy <- highlight
447 updateRBCFramesPreview
()
448 updateRBCFramesCurrent ()
450 win.txtPatient
.TextChanged.AddHandler(fun obj args
-> state.PatientID <- win.txtPatient
.Text)
452 win.menuExit
.Click.AddHandler(fun obj args
-> win.Close())
453 win.menuSave
.Click.AddHandler(fun obj args
-> saveCurrentDocument ())
454 win.menuSaveAs
.Click.AddHandler(fun obj args
-> saveCurrentDocumentAsNewFile ())
455 win.menuOpen
.Click.AddHandler(fun obj args
-> askLoadFile ())
456 win.menuNew
.Click.AddHandler(fun obj args
-> newFile ())
457 win.menuExportResults
.Click.AddHandler(fun obj args
-> exportResults ())
459 win.menuAddSourceImage
.Click.AddHandler(fun obj args
-> importImage ())
461 win.menuAnalysis
.SubmenuOpened.AddHandler(fun obj args
-> win.menuStartAnalysis
.IsEnabled <- state.SourceImages.Count() > 0)
463 win.menuStartAnalysis
.Click.AddHandler(fun obj args
-> showAnalysisWindow ())
465 win.menuHightlightRBC
.Click.AddHandler(fun obj args
-> setHighlightRBC win.menuHightlightRBC
.IsChecked)
467 win.menuAbout
.Click.AddHandler(fun obj args
-> About.showWindow
win)
469 win.Closing.AddHandler(fun obj args
-> askSaveCurrent ())
471 // Zoom on the current image.
472 let adjustCurrentImageBorders (deltaX
: float) (deltaY
: float) =
473 win.borderCurrentImage
.BorderThickness <-
475 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
476 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.,
477 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
478 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.
481 win.canvasCurrentImage
.SizeChanged.AddHandler(fun obj args
->
482 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
483 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
484 if deltaX > 0.5 || deltaY > 0.5 then
485 adjustCurrentImageBorders 0.0
0.0
486 // Center the view at the center of the image initialy.
487 win.scrollViewCurrentImage
.UpdateLayout()
488 win.scrollViewCurrentImage
.ScrollToHorizontalOffset(win.borderCurrentImage
.ActualWidth / 2. - win.scrollViewCurrentImage
.ViewportWidth / 2.)
489 win.scrollViewCurrentImage
.ScrollToVerticalOffset(win.borderCurrentImage
.ActualHeight / 2. - win.scrollViewCurrentImage
.ViewportHeight / 2.)
492 win.scrollViewCurrentImage
.SizeChanged.AddHandler(fun obj args
->
493 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
494 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
495 adjustCurrentImageBorders deltaX deltaY
496 win.scrollViewCurrentImage
.ScrollToHorizontalOffset(win.scrollViewCurrentImage
.HorizontalOffset + deltaX / 8.)
497 win.scrollViewCurrentImage
.ScrollToVerticalOffset(win.scrollViewCurrentImage
.VerticalOffset + deltaY / 8.)
500 let mutable maxScale = 4.
501 let mutable minScale = 0.25
502 let currentImageScaleTransform = ScaleTransform()
503 win.canvasCurrentImage
.LayoutTransform <- currentImageScaleTransform
504 win.borderCurrentImage
.PreviewMouseWheel.AddHandler(fun obj args
->
505 let scaleFactor = if args
.Delta > 0 then 2.0 else 0.5
506 if scaleFactor > 1. && currentScale < maxScale || scaleFactor < 1. && currentScale > minScale then
507 let previousScale = currentScale
509 let newScale = currentScale * scaleFactor
510 if newScale > maxScale then maxScale elif newScale < minScale then minScale else newScale
511 let realScaleFactor = currentScale / previousScale
513 let centerX = win.scrollViewCurrentImage
.HorizontalOffset + win.scrollViewCurrentImage
.ViewportWidth / 2. - win.borderCurrentImage
.BorderThickness.Left
514 let centerY = win.scrollViewCurrentImage
.VerticalOffset + win.scrollViewCurrentImage
.ViewportHeight / 2. - win.borderCurrentImage
.BorderThickness.Top
516 currentImageScaleTransform.ScaleX <- currentScale
517 currentImageScaleTransform.ScaleY <- currentScale
519 win.scrollViewCurrentImage
.ScrollToHorizontalOffset(centerX * realScaleFactor - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
520 win.scrollViewCurrentImage
.ScrollToVerticalOffset(centerY * realScaleFactor - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
525 // Pan on the current image.
526 let mutable scrollStartPosition = Point(0., 0.)
527 let mutable scrollStartOffsetX = 0.
528 let mutable scrollStartOffsetY = 0.
529 win.borderCurrentImage
.PreviewMouseLeftButtonDown.AddHandler(fun obj args
->
530 scrollStartPosition <- args
.GetPosition(win.scrollViewCurrentImage
)
531 scrollStartOffsetX <- win.scrollViewCurrentImage
.HorizontalOffset
532 scrollStartOffsetY <- win.scrollViewCurrentImage
.VerticalOffset
533 win.borderCurrentImage
.Cursor <- Input.Cursors.ScrollAll
534 win.borderCurrentImage
.CaptureMouse() |> ignore
538 win.borderCurrentImage
.PreviewMouseMove.AddHandler(fun obj args
->
539 if win.borderCurrentImage
.IsMouseCaptured then
540 let position = args
.GetPosition(win.scrollViewCurrentImage
)
541 let deltaX = scrollStartPosition.X - position.X
542 let deltaY = scrollStartPosition.Y - position.Y
543 win.scrollViewCurrentImage
.ScrollToHorizontalOffset(deltaX + scrollStartOffsetX)
544 win.scrollViewCurrentImage
.ScrollToVerticalOffset(deltaY + scrollStartOffsetY)
549 win.borderCurrentImage
.PreviewMouseLeftButtonUp.AddHandler(fun obj args
->
550 if win.borderCurrentImage
.IsMouseCaptured then
551 win.borderCurrentImage
.Cursor <- Input.Cursors.Arrow
552 win.borderCurrentImage
.ReleaseMouseCapture()
558 win.InputBindings.Add(
560 ViewModule.FunCommand((fun obj
-> saveCurrentDocument ()), (fun obj
-> true)),
561 Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control)
566 win.InputBindings.Add(
568 ViewModule.FunCommand((fun obj
-> saveCurrentDocumentAsNewFile ()), (fun obj
-> true)),
569 Input.KeyGesture(Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift)
574 win.InputBindings.Add(
576 ViewModule.FunCommand((fun obj
-> askLoadFile ()), (fun obj
-> true)),
577 Input.KeyGesture(Input.Key.O, Input.ModifierKeys.Control)
582 win.InputBindings.Add(
584 ViewModule.FunCommand((fun obj
-> newFile ()), (fun obj
-> true)),
585 Input.KeyGesture(Input.Key.N, Input.ModifierKeys.Control)
590 win.InputBindings.Add(
592 ViewModule.FunCommand((fun obj
-> exportResults ()), (fun obj
-> true)),
593 Input.KeyGesture(Input.Key.E, Input.ModifierKeys.Control)
598 win.InputBindings.Add(
600 ViewModule.FunCommand((fun obj
-> importImage ()), (fun obj
-> true)),
601 Input.KeyGesture(Input.Key.A, Input.ModifierKeys.Control)
605 // Show analysis dialog.
606 win.InputBindings.Add(
608 ViewModule.FunCommand((fun obj
-> showAnalysisWindow ()), (fun obj
-> state.SourceImages.Count() > 0)),
609 Input.KeyGesture(Input.Key.Y, Input.ModifierKeys.Control)
613 // Toggle RBC highlight.
614 win.InputBindings.Add(
616 ViewModule.FunCommand(
619 win.menuHightlightRBC
.IsChecked <- not
win.menuHightlightRBC
.IsChecked
620 setHighlightRBC win.menuHightlightRBC
.IsChecked
624 Input.KeyGesture(Input.Key.H, Input.ModifierKeys.Control)
629 win.scrollViewCurrentImage
.ScrollChanged.AddHandler(fun obj args
-> updateViewportPreview ())
631 updateDocumentStatus ()
632 win.gridImageInformation
.Visibility <- Visibility.Hidden
636 match fileToOpen
with
637 | Some filepath
-> loadFile filepath