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
44 System.Drawing.Rectangle (
45 System.Drawing.Point ((if x < 0 then 0 else x), (if y < 0 then 0 else y)),
46 System.Drawing.Size ((if x + w >= img
.Width then img
.Width - x else w), (if y + h >= img
.Height then img
.Height - y else h))
50 let setRBCFrameStyle (srcImg
: SourceImage) (rbc
: RBC) (frame
: Views.RBCFrame) =
51 frame
.Opacity <- if displayHealthy || rbc.setManually
|| rbc.infected
then 1. else 0.
52 let color = if rbc.infected
then srcImg
.InfectedRBCColor else srcImg.HealthyRBCColor
53 frame
.manuallyAdded
.Visibility <- if rbc.setManually
then Visibility.Visible else Visibility.Hidden
54 frame
.manuallyAdded
.Fill <- color
55 frame
.border
.Stroke <- color
57 let frameStrokeThickness (averageRBCSize
: float) =
58 max
1. (averageRBCSize
/ 60.)
60 let frameFontSize (averageRBCSize
: float) =
61 max
1. (averageRBCSize
/ 8.)
63 let RBCFrameFromExisting (srcImg : SourceImage) (rbc : RBC) (frame
: Views.RBCFrame) (frameThickness
: float) (fontSize
: float) : Views.RBCFrame =
64 frame
.Visibility <- Visibility.Visible
65 frame
.Width <- rbc.size
.Width
66 frame
.Height <- rbc.size
.Height
68 setRBCFrameStyle srcImg rbc frame
69 frame
.border
.StrokeThickness <- frameThickness
70 frame
.txtRBCNumber
.Text <- string rbc.num
71 frame
.txtRBCNumber
.FontSize <- fontSize
74 let updateDocumentStatus () =
75 win.txtDocumentStatus
.Text <- if state.FilePath = "" then "<New document>" else state.FilePath
77 let statusMessageTimer = Threading.DispatcherTimer ()
78 statusMessageTimer.Tick.AddHandler (fun obj args
-> statusMessageTimer.Stop (); win.txtMessageStatus
.Text <- "")
79 statusMessageTimer.Interval <- TimeSpan (0, 0, 2)
81 // To show a use message while a short period of time.
82 let displayStatusMessage (message : string) =
83 win.txtMessageStatus
.Text <- message
84 statusMessageTimer.Stop ()
85 statusMessageTimer.Start ()
87 let highlightRBCFrame (frame
: Views.RBCFrame) (highlight
: bool) =
88 let rbc = frame
.Tag :?> RBC
90 frame
.border
.StrokeThickness <- 3. * frame
.border
.StrokeThickness
91 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then frame
.Opacity <- 1.
93 frame
.border
.StrokeThickness <- frame
.border
.StrokeThickness / 3.
94 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then frame
.Opacity <- 0.
96 let zoomToRBC (rbc : RBC) =
97 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (rbc.center
.X * currentScale - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
98 win.scrollViewCurrentImage
.ScrollToVerticalOffset (rbc.center
.Y * currentScale - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
100 let txtImageName_TextChanged =
101 TextChangedEventHandler (fun obj args
-> state.CurrentImage |> Option.iter
(fun srcImg -> state.SetName srcImg win.txtImageName
.Text))
103 let updateCurrentImageInformation () =
104 win.txtImageName
.TextChanged.RemoveHandler (txtImageName_TextChanged)
105 win.txtImageInformation1
.Inlines.Clear ()
106 win.txtImageInformation2
.Inlines.Clear ()
107 win.txtImageName
.Text <- ""
109 match state.CurrentImage with
111 win.gridImageInformation
.Visibility <- Visibility.Visible
112 win.txtImageName
.Text <- srcImg.Name
113 win.txtImageName
.TextChanged.AddHandler txtImageName_TextChanged
116 let parasitemiaStr = Utils.percentText
srcImg.ImageParasitemia
117 win.txtImageInformation1
.Inlines.Add (Documents.Run ("Parasitemia: ", FontWeight = FontWeights.Bold))
118 win.txtImageInformation1
.Inlines.Add parasitemiaStr
119 win.txtImageInformation1
.Inlines.Add (Documents.LineBreak ())
121 win.txtImageInformation1
.Inlines.Add (Documents.Run ("Last analysis: ", FontWeight = FontWeights.Bold))
122 win.txtImageInformation1
.Inlines.Add (Documents.Run (if srcImg.DateLastAnalysis.Ticks = 0L then "<Never>" else string (srcImg.DateLastAnalysis.ToLocalTime())))
124 // The right part part.
125 win.txtImageInformation2
.Inlines.Add (Documents.Run ("Added infected erythrocyte: ", FontWeight = FontWeights.Bold))
126 win.txtImageInformation2
.Inlines.Add (Documents.Run ((srcImg.ImageNbManuallyChangedRBCStr true) + " " + (srcImg.ImageManuallyChangedRBCStr true)))
127 win.txtImageInformation2
.Inlines.Add (Documents.LineBreak ())
128 win.txtImageInformation2
.Inlines.Add (Documents.Run ("Removed infected erythrocyte: ", FontWeight = FontWeights.Bold))
129 win.txtImageInformation2
.Inlines.Add (Documents.Run ((srcImg.ImageNbManuallyChangedRBCStr false) + " " + (srcImg.ImageManuallyChangedRBCStr false)))
132 win.gridImageInformation
.Visibility <- Visibility.Hidden
134 let updateGlobalParasitemia () =
135 win.txtGlobalParasitemia
.Inlines.Clear ()
136 let total, infected
= state.GlobalParasitemia
137 win.txtGlobalParasitemia
.Inlines.Add (Documents.Run (Utils.percentText
(total, infected
), FontWeight = FontWeights.Bold))
138 if total > 0 && total < warningBelowNumberOfRBC then
139 win.txtGlobalParasitemia
.Inlines.Add (
141 sprintf
" Warning: the number of erythrocytes should be above %d" warningBelowNumberOfRBC,
142 FontWeight = FontWeights.Bold,
143 Foreground = Brushes.Red
147 let updateViewportPreview () =
148 for preview
in win.stackPreviews
.Children |> Seq.cast
<Views.ImageSourcePreview> do
149 let srcImg = preview
.Tag :?> SourceImage
150 if Some srcImg = state.CurrentImage then
151 preview
.viewport
.Visibility <- Visibility.Visible
153 let canvasWidth = win.canvasCurrentImage
.ActualWidth * currentScale
154 let canvasHeight = win.canvasCurrentImage
.ActualHeight * currentScale
155 let previewWidth = (preview
.ActualWidth - preview
.BorderThickness.Left - preview
.BorderThickness.Right)
156 let previewHeight = (preview
.ActualHeight - preview
.BorderThickness.Top - preview
.BorderThickness.Bottom)
158 let marginLeft = previewWidth * (win.scrollViewCurrentImage
.HorizontalOffset - win.borderCurrentImage
.BorderThickness.Left) / canvasWidth - 2.
159 let marginRight = previewWidth * (canvasWidth - (win.scrollViewCurrentImage
.HorizontalOffset - win.borderCurrentImage
.BorderThickness.Right) - win.scrollViewCurrentImage
.ViewportWidth) / canvasWidth - 2.
160 let marginTop = previewHeight * (win.scrollViewCurrentImage
.VerticalOffset - win.borderCurrentImage
.BorderThickness.Top) / canvasHeight - 2.
161 let marginBottom = previewHeight * (canvasHeight - (win.scrollViewCurrentImage
.VerticalOffset - win.borderCurrentImage
.BorderThickness.Bottom) - win.scrollViewCurrentImage
.ViewportHeight) / canvasHeight - 2.
163 preview
.viewport
.Margin <-
171 preview
.viewport
.Visibility <- Visibility.Hidden
173 let rec setAsInfected
(srcImg : SourceImage) (rbc : RBC) (infected
: bool) =
174 state.SetAsInfected rbc infected
175 win.canvasCurrentImage
.Children
176 |> Seq.cast
<Views.RBCFrame>
179 if (frame
.Tag :?> RBC) = rbc then
180 setRBCFrameStyle srcImg rbc frame
182 updateRBCFramesPreview
()
183 updateCurrentImageInformation ()
184 updateGlobalParasitemia ()
186 and RBCFrame (srcImg : SourceImage) (rbc : RBC) (frameThickness
: float) (fontSize
: float) : Views.RBCFrame =
187 let frame = RBCFrameFromExisting srcImg rbc (Views.RBCFrame ()) frameThickness
fontSize
188 frame.SetValue (Panel.ZIndexProperty, Int32.MaxValue - rbc.num
) // To be sure the
189 frame.menuRBCSetAsHealthy
.Click.AddHandler (fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) false)
190 frame.menuRBCSetAsInfected
.Click.AddHandler (fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) true)
191 frame.ContextMenuOpening.AddHandler (
193 if (frame.Tag :?> RBC).infected
then
194 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Visible
195 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Collapsed
197 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Collapsed
198 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Visible
200 frame.ContextMenuClosing.AddHandler (fun obj args
-> if not
frame.IsMouseOver then highlightRBCFrame frame false )
201 frame.MouseEnter.AddHandler (fun obj args
-> highlightRBCFrame frame true)
202 frame.MouseLeave.AddHandler (fun obj args
-> if not
frame.grid
.ContextMenu.IsOpen then highlightRBCFrame frame false)
205 and updateRBCFramesPreview
() =
206 match state.CurrentImage with
208 let mutable currentPreview = 0
209 for rbc in srcImg.RBCs |> List.filter
(fun rbc -> displayHealthy || rbc.infected
) do
210 let previewInfected =
211 if currentPreview < win.stackRBC
.Children.Count then
212 RBCFrameFromExisting srcImg rbc (win.stackRBC
.Children.[currentPreview] :?> Views.RBCFrame) 1. 12.
214 let f = RBCFrame srcImg rbc 1. 12.
215 f.MouseLeftButtonUp.AddHandler (fun obj args
-> zoomToRBC (f.Tag :?> RBC))
216 win.stackRBC
.Children.Add f |> ignore
219 currentPreview <- currentPreview + 1
221 previewInfected.Height <- win.stackRBC
.ActualHeight
222 previewInfected.Width <- win.stackRBC
.ActualHeight * rbc.size
.Width / rbc.size
.Height
223 previewInfected.border
.Fill <- ImageBrush (BitmapSourceConvert.ToBitmapSource (extractRBCPreview srcImg.Img rbc))
225 win.stackRBC
.Children.RemoveRange (currentPreview, win.stackRBC
.Children.Count - currentPreview)
228 updateViewportPreview ()
230 let updateRBCFramesCurrent () =
231 match state.CurrentImage with
233 let mutable currentCanvas = 0
234 let strokeThickness = frameStrokeThickness srcImg.AverageRBCSize
235 let fontSize = frameFontSize srcImg.AverageRBCSize
236 for rbc in srcImg.RBCs do
238 if currentCanvas < win.canvasCurrentImage
.Children.Count then
239 RBCFrameFromExisting srcImg rbc (win.canvasCurrentImage
.Children.[currentCanvas] :?> Views.RBCFrame) strokeThickness fontSize
241 let f = RBCFrame srcImg rbc strokeThickness fontSize
242 win.canvasCurrentImage
.Children.Add f |> ignore
245 currentCanvas <- currentCanvas + 1
247 Canvas.SetLeft (frame, rbc.center
.X - rbc.size
.Width / 2.)
248 Canvas.SetTop (frame, rbc.center
.Y - rbc.size
.Height / 2.)
250 for i
in currentCanvas .. win.canvasCurrentImage
.Children.Count - 1 do
251 win.canvasCurrentImage
.Children.[i
].Visibility <- Visibility.Hidden
254 let askDocumentPathToSave () : string option =
255 let dialog = SaveFileDialog (AddExtension = true, DefaultExt = PiaZ.extension
, Filter = PiaZ.filter
)
257 if state.FilePath <> "" then
258 dialog.FileName <- FileInfo(state.FilePath).Name
259 elif
state.PatientID <> "" then
260 dialog.FileName <- state.PatientID + PiaZ.extension
262 let res = dialog.ShowDialog ()
263 if res.HasValue && res.Value then
268 let saveCurrentDocument () =
270 if state.FilePath = "" then
271 match askDocumentPathToSave () with
273 state.FilePath <- filepath
278 updateDocumentStatus ()
279 displayStatusMessage "Document saved"
281 | :? IOException as ex ->
283 MessageBox.Show (sprintf
"The document cannot be save in \"%s\"" state.FilePath, "Error saving the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
285 let saveCurrentDocumentAsNewFile () =
286 match askDocumentPathToSave () with
288 state.FilePath <- filepath
289 saveCurrentDocument ()
292 // Ask the use to save the current document if neccessary.
293 let askSaveCurrent () =
294 if state.AlteredSinceLastSave then
295 match MessageBox.Show ("Would you like to save the current document?", "Saving the current document", MessageBoxButton.YesNo, MessageBoxImage.Question) with
296 | MessageBoxResult.Yes -> saveCurrentDocument ()
299 let updateCurrentImage () =
300 match state.CurrentImage with
302 win.imgLogos
.Visibility <- Visibility.Collapsed
304 // Highlight the preview.
305 win.stackPreviews
.Children
306 |> Seq.cast
<Views.ImageSourcePreview>
307 |> Seq.iter
(fun preview
-> preview
.border
.BorderThickness <- Thickness (if preview
.Tag = (srcImg :> Object) then 3. else 0.))
309 win.canvasCurrentImage
.Height <- float srcImg.Img.Height
310 win.canvasCurrentImage
.Width <- float srcImg.Img.Width
311 win.canvasCurrentImage
.Background <- ImageBrush (BitmapSourceConvert.ToBitmapSource (srcImg.Img))
313 updateRBCFramesCurrent ()
314 updateRBCFramesPreview
()
317 win.imgLogos
.Visibility <- Visibility.Visible
319 win.stackRBC
.Children.Clear ()
320 win.canvasCurrentImage
.Children.Clear ()
321 win.canvasCurrentImage
.Background <- canvasCurrentImageColor
323 updateCurrentImageInformation ()
325 let setCurrentImage (srcImg : SourceImage) =
326 if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg then
327 state.CurrentImage <- Some srcImg
328 updateCurrentImage ()
330 let addPreview (srcImg : SourceImage) =
331 let imgCtrl = Views.ImageSourcePreview (Margin = Thickness 3.)
333 imgCtrl.menuRemoveImage
.Click.AddHandler (
335 win.stackPreviews
.Children.Remove (imgCtrl)
336 let srcImg = imgCtrl.Tag :?> SourceImage
337 let currentRemoved = Some srcImg = state.CurrentImage
338 state.RemoveSourceImage srcImg
339 if currentRemoved then
340 updateCurrentImage ()
342 updateGlobalParasitemia ()
344 // Update image numbers.
345 win.stackPreviews
.Children |> Seq.cast
<Views.ImageSourcePreview> |> Seq.iter
(fun imgPreview
-> imgPreview
.txtImageNumber
.Text <- (imgPreview
.Tag :?> SourceImage).RomanNum)
348 imgCtrl.Tag <- srcImg
349 imgCtrl.txtImageNumber
.Text <- string srcImg.RomanNum
351 let height = srcImg.Img.Height * width / srcImg.Img.Width
352 imgCtrl.imagePreview
.Source <- BitmapSourceConvert.ToBitmapSource (srcImg.Img.Resize (width, height, Emgu.CV.CvEnum.Inter.Cubic))
353 win.stackPreviews
.Children.Add imgCtrl |> ignore
355 // Zoom to a mouse position into the control 'imgCtrl'.
356 let zoomTo (mousePos
: Point) =
357 let canvasW = win.canvasCurrentImage
.ActualWidth * currentScale
358 let canvasH = win.canvasCurrentImage
.ActualHeight * currentScale
359 let centerX = (mousePos
.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
360 let centerY = (mousePos
.Y - imgCtrl.BorderThickness.Top) / (imgCtrl.ActualHeight - imgCtrl.BorderThickness.Top) * canvasH
361 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (centerX - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
362 win.scrollViewCurrentImage
.ScrollToVerticalOffset (centerY - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
364 imgCtrl.MouseLeftButtonDown.AddHandler (
366 setCurrentImage (state.SourceImages |> Seq.find
(fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
367 imgCtrl.UpdateLayout ()
368 zoomTo (args
.GetPosition (imgCtrl))
369 imgCtrl.CaptureMouse () |> ignore
372 imgCtrl.MouseMove.AddHandler (
374 if imgCtrl.IsMouseCaptured then
375 zoomTo (args
.GetPosition imgCtrl)
378 imgCtrl.MouseLeftButtonUp.AddHandler (
380 if imgCtrl.IsMouseCaptured then
381 imgCtrl.ReleaseMouseCapture ()
384 let updatePreviews () =
385 win.stackPreviews
.Children.Clear ()
386 for srcImg in state.SourceImages do
388 updateCurrentImage ()
391 win.txtPatient
.Text <- state.PatientID
393 updateGlobalParasitemia ()
394 updateDocumentStatus ()
396 let loadFile (filepath
: string) =
398 let previousFilePath = state.FilePath
400 state.FilePath <- filepath
404 | :? IOException as ex ->
406 state.FilePath <- previousFilePath
407 MessageBox.Show (sprintf
"The document cannot be loaded from \"%s\"" filepath
, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
410 let dialog = OpenFileDialog (Filter = PiaZ.filter
)
411 let res = dialog.ShowDialog ()
412 if res.HasValue && res.Value then
413 loadFile dialog.FileName
420 let exportResults () =
421 let extension = ".txt"
422 let dialog = SaveFileDialog (AddExtension = true, DefaultExt = extension)
424 if state.FilePath <> "" then
425 dialog.FileName <- Path.GetFileNameWithoutExtension state.FilePath + extension
426 elif
state.PatientID <> "" then
427 dialog.FileName <- state.PatientID + extension
429 let res = dialog.ShowDialog ()
430 if res.HasValue && res.Value then
432 Export.exportResults state dialog.FileName
434 | :? IOException as ex ->
436 MessageBox.Show (sprintf
"The results cannot be exported in \"%s\"" state.FilePath, "Error exporting the files", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
439 let dialog = OpenFileDialog (Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
440 let res = dialog.ShowDialog ()
441 if res.HasValue && res.Value then
442 let noSourceImage = state.SourceImages.Count () = 0
444 for filename
in dialog.FileNames do
446 let srcImg = state.AddSourceImage filename defaultConfig
451 MessageBox.Show (sprintf
"Unable to read the image from \"%s\"" filename, "Error adding an image", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
453 updateGlobalParasitemia ()
455 if noSourceImage then
456 updateCurrentImage ()
458 let showAnalysisWindow () =
459 if Analysis.showWindow
win state then
460 updateGlobalParasitemia ()
461 updateCurrentImage ()
463 let setHighlightRBC (highlight
: bool) =
464 displayHealthy <- highlight
465 updateRBCFramesPreview
()
466 updateRBCFramesCurrent ()
468 win.txtPatient
.TextChanged.AddHandler (fun obj args
-> state.PatientID <- win.txtPatient
.Text)
470 win.menuExit
.Click.AddHandler (fun obj args
-> win.Close ())
471 win.menuSave
.Click.AddHandler (fun obj args
-> saveCurrentDocument ())
472 win.menuSaveAs
.Click.AddHandler (fun obj args
-> saveCurrentDocumentAsNewFile ())
473 win.menuOpen
.Click.AddHandler (fun obj args
-> askLoadFile ())
474 win.menuNew
.Click.AddHandler (fun obj args
-> newFile ())
475 win.menuExportResults
.Click.AddHandler (fun obj args
-> exportResults ())
477 win.menuAddSourceImage
.Click.AddHandler (fun obj args
-> importImage ())
479 win.menuAnalysis
.SubmenuOpened.AddHandler (fun obj args
-> win.menuStartAnalysis
.IsEnabled <- state.SourceImages.Count () > 0)
481 win.menuStartAnalysis
.Click.AddHandler (fun obj args
-> showAnalysisWindow ())
483 win.menuHightlightRBC
.Click.AddHandler (fun obj args
-> setHighlightRBC win.menuHightlightRBC
.IsChecked)
485 win.menuAbout
.Click.AddHandler (fun obj args
-> About.showWindow
win)
487 win.menuCommandLineArguments
.Click.AddHandler (fun obj args
-> CommandLineArguments.showWindow
win)
489 win.Closing.AddHandler (fun obj args
-> askSaveCurrent ())
491 // Zoom on the current image.
492 let adjustCurrentImageBorders (deltaX
: float) (deltaY
: float) =
493 win.borderCurrentImage
.BorderThickness <-
495 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
496 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.,
497 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
498 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.
501 win.canvasCurrentImage
.SizeChanged.AddHandler (
503 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
504 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
505 if deltaX > 0.5 || deltaY > 0.5 then
506 adjustCurrentImageBorders 0.0
0.0
507 // Center the view at the center of the image initialy.
508 win.scrollViewCurrentImage
.UpdateLayout ()
509 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (win.borderCurrentImage
.ActualWidth / 2. - win.scrollViewCurrentImage
.ViewportWidth / 2.)
510 win.scrollViewCurrentImage
.ScrollToVerticalOffset (win.borderCurrentImage
.ActualHeight / 2. - win.scrollViewCurrentImage
.ViewportHeight / 2.)
513 win.scrollViewCurrentImage
.SizeChanged.AddHandler (
515 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
516 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
517 adjustCurrentImageBorders deltaX deltaY
518 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (win.scrollViewCurrentImage
.HorizontalOffset + deltaX / 8.)
519 win.scrollViewCurrentImage
.ScrollToVerticalOffset (win.scrollViewCurrentImage
.VerticalOffset + deltaY / 8.)
522 let mutable maxScale = 4.
523 let mutable minScale = 0.25
524 let currentImageScaleTransform = ScaleTransform ()
525 win.canvasCurrentImage
.LayoutTransform <- currentImageScaleTransform
526 win.borderCurrentImage
.PreviewMouseWheel.AddHandler (
528 let scaleFactor = if args
.Delta > 0 then 2.0 else 0.5
529 if scaleFactor > 1. && currentScale < maxScale || scaleFactor < 1. && currentScale > minScale then
530 let previousScale = currentScale
532 let newScale = currentScale * scaleFactor
533 if newScale > maxScale then maxScale elif newScale < minScale then minScale else newScale
534 let realScaleFactor = currentScale / previousScale
536 let centerX = win.scrollViewCurrentImage
.HorizontalOffset + win.scrollViewCurrentImage
.ViewportWidth / 2. - win.borderCurrentImage
.BorderThickness.Left
537 let centerY = win.scrollViewCurrentImage
.VerticalOffset + win.scrollViewCurrentImage
.ViewportHeight / 2. - win.borderCurrentImage
.BorderThickness.Top
539 currentImageScaleTransform.ScaleX <- currentScale
540 currentImageScaleTransform.ScaleY <- currentScale
542 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (centerX * realScaleFactor - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
543 win.scrollViewCurrentImage
.ScrollToVerticalOffset (centerY * realScaleFactor - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
548 // Pan on the current image.
549 let mutable scrollStartPosition = Point (0., 0.)
550 let mutable scrollStartOffsetX = 0.
551 let mutable scrollStartOffsetY = 0.
552 win.borderCurrentImage
.PreviewMouseLeftButtonDown.AddHandler (
554 scrollStartPosition <- args
.GetPosition win.scrollViewCurrentImage
555 scrollStartOffsetX <- win.scrollViewCurrentImage
.HorizontalOffset
556 scrollStartOffsetY <- win.scrollViewCurrentImage
.VerticalOffset
557 win.borderCurrentImage
.Cursor <- Input.Cursors.ScrollAll
558 win.borderCurrentImage
.CaptureMouse () |> ignore
562 win.borderCurrentImage
.PreviewMouseMove.AddHandler (
564 if win.borderCurrentImage
.IsMouseCaptured then
565 let position = args
.GetPosition win.scrollViewCurrentImage
566 let deltaX = scrollStartPosition.X - position.X
567 let deltaY = scrollStartPosition.Y - position.Y
568 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (deltaX + scrollStartOffsetX)
569 win.scrollViewCurrentImage
.ScrollToVerticalOffset (deltaY + scrollStartOffsetY)
574 win.borderCurrentImage
.PreviewMouseLeftButtonUp.AddHandler (
576 if win.borderCurrentImage
.IsMouseCaptured then
577 win.borderCurrentImage
.Cursor <- Input.Cursors.Arrow
578 win.borderCurrentImage
.ReleaseMouseCapture ()
584 win.InputBindings.Add (
586 ViewModule.FunCommand ((fun obj
-> saveCurrentDocument ()), (fun obj
-> true)),
587 Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control)
592 win.InputBindings.Add (
594 ViewModule.FunCommand ((fun obj
-> saveCurrentDocumentAsNewFile ()), (fun obj
-> true)),
595 Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift)
600 win.InputBindings.Add (
602 ViewModule.FunCommand ((fun obj
-> askLoadFile ()), (fun obj
-> true)),
603 Input.KeyGesture (Input.Key.O, Input.ModifierKeys.Control)
608 win.InputBindings.Add (
610 ViewModule.FunCommand ((fun obj
-> newFile ()), (fun obj
-> true)),
611 Input.KeyGesture (Input.Key.N, Input.ModifierKeys.Control)
616 win.InputBindings.Add (
618 ViewModule.FunCommand ((fun obj
-> exportResults ()), (fun obj
-> true)),
619 Input.KeyGesture (Input.Key.E, Input.ModifierKeys.Control)
624 win.InputBindings.Add (
626 ViewModule.FunCommand ((fun obj
-> importImage ()), (fun obj
-> true)),
627 Input.KeyGesture (Input.Key.A, Input.ModifierKeys.Control)
631 // Show analysis dialog.
632 win.InputBindings.Add (
634 ViewModule.FunCommand ((fun obj
-> showAnalysisWindow ()), (fun obj
-> state.SourceImages.Count () > 0)),
635 Input.KeyGesture (Input.Key.Y, Input.ModifierKeys.Control)
639 // Toggle RBC highlight.
640 win.InputBindings.Add (
642 ViewModule.FunCommand (
645 win.menuHightlightRBC
.IsChecked <- not
win.menuHightlightRBC
.IsChecked
646 setHighlightRBC win.menuHightlightRBC
.IsChecked
650 Input.KeyGesture (Input.Key.H, Input.ModifierKeys.Control)
655 win.scrollViewCurrentImage
.ScrollChanged.AddHandler (fun obj args
-> updateViewportPreview ())
657 updateDocumentStatus ()
658 win.gridImageInformation
.Visibility <- Visibility.Hidden
662 match fileToOpen
with
663 | Some filepath
-> loadFile filepath