1
module ParasitemiaUI.GUI
7 open System.Windows.Media
8 open System.Windows.Controls
9 open Microsoft.Win32 // For the common dialogs.
13 open ParasitemiaUIControls
14 open ParasitemiaCore.Config
15 open ParasitemiaCore.Utils
18 let run (defaultConfig
: Config) (fileToOpen
: string option) =
19 let app = new Application ()
20 let win = MainWindow ()
22 let state = State.State defaultConfig
23 let mutable currentScale = 1.
24 let mutable displayHealthy = false
25 let warningBelowNumberOfRBC = 1000
28 let canvasCurrentImageColor = win.canvasCurrentImage
.Background
29 win.menuHightlightRBC
.IsChecked <- displayHealthy
32 let extractRBCPreview (img
: Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte
>) (rbc
: RBC) : Emgu.CV.Image<Emgu.CV.Structure.Bgr, byte
> =
33 let rbcWidth = rbc
.size
.Width
34 let rbcHeight = rbc
.size
.Height
35 let x = rbc
.center
.X - rbcWidth / 2. |> roundInt
36 let y = rbc
.center
.Y - rbcHeight / 2. |> roundInt
37 let w = roundInt
rbcWidth
38 let h = roundInt
rbcHeight
40 System.Drawing.Rectangle (
41 System.Drawing.Point ((if x < 0 then 0 else x), (if y < 0 then 0 else y)),
42 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))
46 let setRBCFrameStyle (srcImg
: SourceImage) (rbc
: RBC) (frame
: RBCFrame) =
47 frame
.Opacity <- if displayHealthy || rbc.setManually
|| rbc.infected
then 1. else 0.
48 let color = if rbc.infected
then srcImg
.InfectedRBCColor else srcImg.HealthyRBCColor
49 frame
.manuallyAdded
.Visibility <- if rbc.setManually
then Visibility.Visible else Visibility.Hidden
50 frame
.manuallyAdded
.Fill <- color
51 frame
.border
.Stroke <- color
53 let frameStrokeThickness (averageRBCSize
: float) =
54 max
1. (averageRBCSize
/ 60.)
56 let frameFontSize (averageRBCSize
: float) =
57 max
1. (averageRBCSize
/ 6.)
59 let createRBCFrameFromExisting (srcImg : SourceImage) (rbc : RBC) (frame
: RBCFrame) (frameThickness
: float) (fontSize
: float) (isTextBelow
: bool) : RBCFrame =
60 frame
.Visibility <- Visibility.Visible
61 frame
.Width <- rbc.size
.Width
62 frame
.Height <- rbc.size
.Height
64 frame
.IsTextBelow <- isTextBelow
65 setRBCFrameStyle srcImg rbc frame
66 frame
.border
.StrokeThickness <- frameThickness
67 frame
.txtRBCNumber
.Text <- string rbc.num
68 frame
.txtRBCNumber
.FontSize <- fontSize
71 let updateDocumentStatus () =
72 win.txtDocumentStatus
.Text <- if state.FilePath = "" then "<New document>" else state.FilePath
74 let statusMessageTimer = Threading.DispatcherTimer ()
75 statusMessageTimer.Tick.AddHandler (fun obj args
-> statusMessageTimer.Stop (); win.txtMessageStatus
.Text <- "")
76 statusMessageTimer.Interval <- TimeSpan (0, 0, 2)
78 // To show a use message while a short period of time.
79 let displayStatusMessage (message : string) =
80 win.txtMessageStatus
.Text <- message
81 statusMessageTimer.Stop ()
82 statusMessageTimer.Start ()
84 let highlightRBCFrame (frame
: RBCFrame) (highlight
: bool) =
85 let rbc = frame
.Tag :?> RBC
87 frame
.border
.StrokeThickness <- 3. * frame
.border
.StrokeThickness
88 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then frame
.Opacity <- 1.
90 frame
.border
.StrokeThickness <- frame
.border
.StrokeThickness / 3.
91 if not
rbc.infected
&& not
rbc.setManually
&& not
displayHealthy then frame
.Opacity <- 0.
93 let zoomToRBC (rbc : RBC) =
94 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (rbc.center
.X * currentScale - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
95 win.scrollViewCurrentImage
.ScrollToVerticalOffset (rbc.center
.Y * currentScale - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
97 let txtImageName_TextChanged =
98 TextChangedEventHandler (fun obj args
-> state.CurrentImage |> Option.iter
(fun srcImg -> state.SetName srcImg win.txtImageName
.Text))
100 let updateCurrentImageInformation () =
101 win.txtImageName
.TextChanged.RemoveHandler (txtImageName_TextChanged)
102 win.txtImageInformation1
.Inlines.Clear ()
103 win.txtImageInformation2
.Inlines.Clear ()
104 win.txtImageName
.Text <- ""
106 match state.CurrentImage with
108 win.gridImageInformation
.Visibility <- Visibility.Visible
109 win.txtImageName
.Text <- srcImg.Name
110 win.txtImageName
.TextChanged.AddHandler txtImageName_TextChanged
113 let parasitemiaStr = Utils.percentText
srcImg.ImageParasitemia
114 win.txtImageInformation1
.Inlines.Add (Documents.Run ("Parasitemia: ", FontWeight = FontWeights.Bold))
115 win.txtImageInformation1
.Inlines.Add parasitemiaStr
116 win.txtImageInformation1
.Inlines.Add (Documents.LineBreak ())
118 win.txtImageInformation1
.Inlines.Add (Documents.Run ("Last analysis: ", FontWeight = FontWeights.Bold))
119 win.txtImageInformation1
.Inlines.Add (Documents.Run (if srcImg.DateLastAnalysis.Ticks = 0L then "<Never>" else string (srcImg.DateLastAnalysis.ToLocalTime())))
121 // The right part part.
122 win.txtImageInformation2
.Inlines.Add (Documents.Run ("Added infected erythrocyte: ", FontWeight = FontWeights.Bold))
123 win.txtImageInformation2
.Inlines.Add (Documents.Run ((srcImg.ImageNbManuallyChangedRBCStr true) + " " + (srcImg.ImageManuallyChangedRBCStr true)))
124 win.txtImageInformation2
.Inlines.Add (Documents.LineBreak ())
125 win.txtImageInformation2
.Inlines.Add (Documents.Run ("Removed infected erythrocyte: ", FontWeight = FontWeights.Bold))
126 win.txtImageInformation2
.Inlines.Add (Documents.Run ((srcImg.ImageNbManuallyChangedRBCStr false) + " " + (srcImg.ImageManuallyChangedRBCStr false)))
129 win.gridImageInformation
.Visibility <- Visibility.Hidden
131 let updateGlobalParasitemia () =
132 win.txtGlobalParasitemia
.Inlines.Clear ()
133 let total, infected
= state.GlobalParasitemia
134 win.txtGlobalParasitemia
.Inlines.Add (Documents.Run (Utils.percentText
(total, infected
), FontWeight = FontWeights.Bold))
135 if total > 0 && total < warningBelowNumberOfRBC then
136 win.txtGlobalParasitemia
.Inlines.Add (
138 sprintf
" Warning: the number of erythrocytes should be above %d" warningBelowNumberOfRBC,
139 FontWeight = FontWeights.Bold,
140 Foreground = Brushes.Red
144 let updateViewportPreview () =
145 for preview
in win.stackPreviews
.Children |> Seq.cast
<ImageSourcePreview> do
146 let srcImg = preview
.Tag :?> SourceImage
147 if Some srcImg = state.CurrentImage then
148 preview
.viewport
.Visibility <- Visibility.Visible
150 let canvasWidth = win.canvasCurrentImage
.ActualWidth * currentScale
151 let canvasHeight = win.canvasCurrentImage
.ActualHeight * currentScale
152 let previewWidth = (preview
.ActualWidth - preview
.BorderThickness.Left - preview
.BorderThickness.Right)
153 let previewHeight = (preview
.ActualHeight - preview
.BorderThickness.Top - preview
.BorderThickness.Bottom)
155 let marginLeft = previewWidth * (win.scrollViewCurrentImage
.HorizontalOffset - win.borderCurrentImage
.BorderThickness.Left) / canvasWidth - 2.
156 let marginRight = previewWidth * (canvasWidth - (win.scrollViewCurrentImage
.HorizontalOffset - win.borderCurrentImage
.BorderThickness.Right) - win.scrollViewCurrentImage
.ViewportWidth) / canvasWidth - 2.
157 let marginTop = previewHeight * (win.scrollViewCurrentImage
.VerticalOffset - win.borderCurrentImage
.BorderThickness.Top) / canvasHeight - 2.
158 let marginBottom = previewHeight * (canvasHeight - (win.scrollViewCurrentImage
.VerticalOffset - win.borderCurrentImage
.BorderThickness.Bottom) - win.scrollViewCurrentImage
.ViewportHeight) / canvasHeight - 2.
160 preview
.viewport
.Margin <-
168 preview
.viewport
.Visibility <- Visibility.Hidden
170 let rec setAsInfected
(srcImg : SourceImage) (rbc : RBC) (infected
: bool) =
171 state.SetAsInfected rbc infected
172 win.canvasCurrentImage
.Children
173 |> Seq.cast
<RBCFrame>
176 if (frame
.Tag :?> RBC) = rbc then
177 setRBCFrameStyle srcImg rbc frame
179 updateRBCFramesPreview
()
180 updateCurrentImageInformation ()
181 updateGlobalParasitemia ()
183 and createRBCFrame
(srcImg : SourceImage) (rbc : RBC) (frameThickness
: float) (fontSize
: float) (isTextBelow
: bool) : RBCFrame =
184 let frame = createRBCFrameFromExisting srcImg rbc (RBCFrame ()) frameThickness
fontSize isTextBelow
185 frame.SetValue (Panel.ZIndexProperty, Int32.MaxValue - rbc.num
) // To be sure the
186 frame.menuRBCSetAsHealthy
.Click.AddHandler (fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) false)
187 frame.menuRBCSetAsInfected
.Click.AddHandler (fun obj args
-> setAsInfected
srcImg (frame.Tag :?> RBC) true)
188 frame.ContextMenuOpening.AddHandler (
190 if (frame.Tag :?> RBC).infected
then
191 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Visible
192 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Collapsed
194 frame.menuRBCSetAsHealthy
.Visibility <- Visibility.Collapsed
195 frame.menuRBCSetAsInfected
.Visibility <- Visibility.Visible
197 frame.ContextMenuClosing.AddHandler (fun obj args
-> if not
frame.IsMouseOver then highlightRBCFrame frame false )
198 frame.MouseEnter.AddHandler (fun obj args
-> highlightRBCFrame frame true)
199 frame.MouseLeave.AddHandler (fun obj args
-> if not
frame.grid
.ContextMenu.IsOpen then highlightRBCFrame frame false)
202 and updateRBCFramesPreview
() =
203 match state.CurrentImage with
205 let mutable currentPreview = 0
206 for rbc in srcImg.RBCs |> List.filter
(fun rbc -> displayHealthy || rbc.infected
) do
207 let previewInfected =
208 if currentPreview < win.stackRBC
.Children.Count then
209 createRBCFrameFromExisting srcImg rbc (win.stackRBC
.Children.[currentPreview] :?> RBCFrame) 1. 12. false
211 let f = createRBCFrame
srcImg rbc 1. 12. false
212 f.MouseLeftButtonUp.AddHandler (fun obj args
-> zoomToRBC (f.Tag :?> RBC))
213 win.stackRBC
.Children.Add f |> ignore
216 currentPreview <- currentPreview + 1
218 previewInfected.Height <- win.stackRBC
.ActualHeight
219 previewInfected.Width <- win.stackRBC
.ActualHeight * rbc.size
.Width / rbc.size
.Height
220 previewInfected.border
.Fill <- ImageBrush (BitmapSourceConvert.ToBitmapSource (extractRBCPreview srcImg.Img rbc))
222 win.stackRBC
.Children.RemoveRange (currentPreview, win.stackRBC
.Children.Count - currentPreview)
225 updateViewportPreview ()
227 let updateRBCFramesCurrent () =
228 match state.CurrentImage with
230 let mutable currentCanvas = 0
231 let strokeThickness = frameStrokeThickness srcImg.AverageRBCSize
232 let fontSize = frameFontSize srcImg.AverageRBCSize
233 for rbc in srcImg.RBCs do
235 if currentCanvas < win.canvasCurrentImage
.Children.Count then
236 createRBCFrameFromExisting srcImg rbc (win.canvasCurrentImage
.Children.[currentCanvas] :?> RBCFrame) strokeThickness fontSize true
238 let f = createRBCFrame
srcImg rbc strokeThickness fontSize true
239 win.canvasCurrentImage
.Children.Add f |> ignore
242 currentCanvas <- currentCanvas + 1
244 Canvas.SetLeft (frame, rbc.center
.X - rbc.size
.Width / 2.)
245 Canvas.SetTop (frame, rbc.center
.Y - rbc.size
.Height / 2.)
247 for i
in currentCanvas .. win.canvasCurrentImage
.Children.Count - 1 do
248 win.canvasCurrentImage
.Children.[i
].Visibility <- Visibility.Hidden
251 let askDocumentPathToSave () : string option =
252 let dialog = SaveFileDialog (AddExtension = true, DefaultExt = PiaZ.extension
, Filter = PiaZ.filter
)
254 if state.FilePath <> "" then
255 dialog.FileName <- FileInfo(state.FilePath).Name
256 elif
state.PatientID <> "" then
257 dialog.FileName <- state.PatientID + PiaZ.extension
259 let res = dialog.ShowDialog ()
260 if res.HasValue && res.Value then
265 let saveCurrentDocument () =
267 if state.FilePath = "" then
268 match askDocumentPathToSave () with
270 state.FilePath <- filepath
275 updateDocumentStatus ()
276 displayStatusMessage "Document saved"
278 | :? IOException as ex ->
280 MessageBox.Show (sprintf
"The document cannot be save in \"%s\"" state.FilePath, "Error saving the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
282 let saveCurrentDocumentAsNewFile () =
283 match askDocumentPathToSave () with
285 state.FilePath <- filepath
286 saveCurrentDocument ()
289 // Ask the use to save the current document if neccessary.
290 let askSaveCurrent () =
291 if state.AlteredSinceLastSave then
292 match MessageBox.Show ("Would you like to save the current document?", "Saving the current document", MessageBoxButton.YesNo, MessageBoxImage.Question) with
293 | MessageBoxResult.Yes -> saveCurrentDocument ()
296 let updateCurrentImage () =
297 match state.CurrentImage with
299 win.imgLogos
.Visibility <- Visibility.Collapsed
301 // Highlight the preview.
302 win.stackPreviews
.Children
303 |> Seq.cast
<ImageSourcePreview>
304 |> Seq.iter
(fun preview
-> preview
.border
.BorderThickness <- Thickness (if preview
.Tag = (srcImg :> Object) then 3. else 0.))
306 win.canvasCurrentImage
.Height <- float srcImg.Img.Height
307 win.canvasCurrentImage
.Width <- float srcImg.Img.Width
308 win.canvasCurrentImage
.Background <- ImageBrush (BitmapSourceConvert.ToBitmapSource (srcImg.Img))
310 updateRBCFramesCurrent ()
311 updateRBCFramesPreview
()
314 win.imgLogos
.Visibility <- Visibility.Visible
316 win.stackRBC
.Children.Clear ()
317 win.canvasCurrentImage
.Children.Clear ()
318 win.canvasCurrentImage
.Background <- canvasCurrentImageColor
320 updateCurrentImageInformation ()
322 let setCurrentImage (srcImg : SourceImage) =
323 if state.CurrentImage.IsNone || state.CurrentImage.Value <> srcImg then
324 state.CurrentImage <- Some srcImg
325 updateCurrentImage ()
327 let addPreview (srcImg : SourceImage) =
328 let imgCtrl = ImageSourcePreview (Margin = Thickness 3.)
330 imgCtrl.menuRemoveImage
.Click.AddHandler (
332 win.stackPreviews
.Children.Remove (imgCtrl)
333 let srcImg = imgCtrl.Tag :?> SourceImage
334 let currentRemoved = Some srcImg = state.CurrentImage
335 state.RemoveSourceImage srcImg
336 if currentRemoved then
337 updateCurrentImage ()
339 updateGlobalParasitemia ()
341 // Update image numbers.
342 win.stackPreviews
.Children |> Seq.cast
<ImageSourcePreview> |> Seq.iter
(fun imgPreview
-> imgPreview
.txtImageNumber
.Text <- (imgPreview
.Tag :?> SourceImage).RomanNum)
345 imgCtrl.Tag <- srcImg
346 imgCtrl.txtImageNumber
.Text <- string srcImg.RomanNum
348 let height = srcImg.Img.Height * width / srcImg.Img.Width
349 imgCtrl.imagePreview
.Source <- BitmapSourceConvert.ToBitmapSource (srcImg.Img.Resize (width, height, Emgu.CV.CvEnum.Inter.Cubic))
350 win.stackPreviews
.Children.Add imgCtrl |> ignore
352 // Zoom to a mouse position into the control 'imgCtrl'.
353 let zoomTo (mousePos
: Point) =
354 let canvasW = win.canvasCurrentImage
.ActualWidth * currentScale
355 let canvasH = win.canvasCurrentImage
.ActualHeight * currentScale
356 let centerX = (mousePos
.X - imgCtrl.BorderThickness.Left) / (imgCtrl.ActualWidth - imgCtrl.BorderThickness.Left) * canvasW
357 let centerY = (mousePos
.Y - imgCtrl.BorderThickness.Top) / (imgCtrl.ActualHeight - imgCtrl.BorderThickness.Top) * canvasH
358 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (centerX - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
359 win.scrollViewCurrentImage
.ScrollToVerticalOffset (centerY - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
361 imgCtrl.MouseLeftButtonDown.AddHandler (
363 setCurrentImage (state.SourceImages |> Seq.find
(fun srcImg -> (srcImg :> Object) = imgCtrl.Tag))
364 imgCtrl.UpdateLayout ()
365 zoomTo (args
.GetPosition (imgCtrl))
366 imgCtrl.CaptureMouse () |> ignore
369 imgCtrl.MouseMove.AddHandler (
371 if imgCtrl.IsMouseCaptured then
372 zoomTo (args
.GetPosition imgCtrl)
375 imgCtrl.MouseLeftButtonUp.AddHandler (
377 if imgCtrl.IsMouseCaptured then
378 imgCtrl.ReleaseMouseCapture ()
381 let updatePreviews () =
382 win.stackPreviews
.Children.Clear ()
383 for srcImg in state.SourceImages do
385 updateCurrentImage ()
388 win.txtPatient
.Text <- state.PatientID
390 updateGlobalParasitemia ()
391 updateDocumentStatus ()
393 let loadFile (filepath
: string) =
395 let previousFilePath = state.FilePath
397 state.FilePath <- filepath
401 | :? IOException as ex ->
403 state.FilePath <- previousFilePath
404 MessageBox.Show (sprintf
"The document cannot be loaded from \"%s\"" filepath
, "Error loading the document", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
407 let dialog = OpenFileDialog (Filter = PiaZ.filter
)
408 let res = dialog.ShowDialog ()
409 if res.HasValue && res.Value then
410 loadFile dialog.FileName
417 let exportResults () =
418 let extension = ".txt"
419 let dialog = SaveFileDialog (AddExtension = true, DefaultExt = extension)
421 if state.FilePath <> "" then
422 dialog.FileName <- Path.GetFileNameWithoutExtension state.FilePath + extension
423 elif
state.PatientID <> "" then
424 dialog.FileName <- state.PatientID + extension
426 let res = dialog.ShowDialog ()
427 if res.HasValue && res.Value then
429 Export.exportResults state dialog.FileName
431 | :? IOException as ex ->
433 MessageBox.Show (sprintf
"The results cannot be exported in \"%s\"" state.FilePath, "Error exporting the files", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
436 let dialog = OpenFileDialog (Filter = "Image Files|*.png;*.jpg;*.tif;*.tiff", Multiselect = true)
437 let res = dialog.ShowDialog ()
438 if res.HasValue && res.Value then
439 let noSourceImage = state.SourceImages.Count () = 0
441 for filename
in dialog.FileNames do
443 let srcImg = state.AddSourceImage filename defaultConfig
448 MessageBox.Show (sprintf
"Unable to read the image from \"%s\"" filename, "Error adding an image", MessageBoxButton.OK, MessageBoxImage.Error) |> ignore
450 updateGlobalParasitemia ()
452 if noSourceImage then
453 updateCurrentImage ()
455 let showAnalysisWindow () =
456 if Analysis.showWindow
win state then
457 updateGlobalParasitemia ()
458 updateCurrentImage ()
460 let setHighlightRBC (highlight
: bool) =
461 displayHealthy <- highlight
462 updateRBCFramesPreview
()
463 updateRBCFramesCurrent ()
465 win.txtPatient
.TextChanged.AddHandler (fun obj args
-> state.PatientID <- win.txtPatient
.Text)
467 win.menuExit
.Click.AddHandler (fun obj args
-> win.Close ())
468 win.menuSave
.Click.AddHandler (fun obj args
-> saveCurrentDocument ())
469 win.menuSaveAs
.Click.AddHandler (fun obj args
-> saveCurrentDocumentAsNewFile ())
470 win.menuOpen
.Click.AddHandler (fun obj args
-> askLoadFile ())
471 win.menuNew
.Click.AddHandler (fun obj args
-> newFile ())
472 win.menuExportResults
.Click.AddHandler (fun obj args
-> exportResults ())
474 win.menuAddSourceImage
.Click.AddHandler (fun obj args
-> importImage ())
476 win.menuAnalysis
.SubmenuOpened.AddHandler (fun obj args
-> win.menuStartAnalysis
.IsEnabled <- state.SourceImages.Count () > 0)
478 win.menuStartAnalysis
.Click.AddHandler (fun obj args
-> showAnalysisWindow ())
480 win.menuHightlightRBC
.Click.AddHandler (fun obj args
-> setHighlightRBC win.menuHightlightRBC
.IsChecked)
482 win.menuAbout
.Click.AddHandler (fun obj args
-> About.showWindow
win)
484 win.menuCommandLineArguments
.Click.AddHandler (fun obj args
-> CommandLineArguments.showWindow
win)
486 win.Closing.AddHandler (fun obj args
-> askSaveCurrent ())
488 // Zoom on the current image.
489 let adjustCurrentImageBorders (deltaX
: float) (deltaY
: float) =
490 win.borderCurrentImage
.BorderThickness <-
492 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
493 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.,
494 (win.scrollViewCurrentImage
.ViewportWidth + deltaX
) / 2.,
495 (win.scrollViewCurrentImage
.ViewportHeight + deltaY
) / 2.
498 win.canvasCurrentImage
.SizeChanged.AddHandler (
500 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
501 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
502 if deltaX > 0.5 || deltaY > 0.5 then
503 adjustCurrentImageBorders 0.0
0.0
504 // Center the view at the center of the image initialy.
505 win.scrollViewCurrentImage
.UpdateLayout ()
506 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (win.borderCurrentImage
.ActualWidth / 2. - win.scrollViewCurrentImage
.ViewportWidth / 2.)
507 win.scrollViewCurrentImage
.ScrollToVerticalOffset (win.borderCurrentImage
.ActualHeight / 2. - win.scrollViewCurrentImage
.ViewportHeight / 2.)
510 win.scrollViewCurrentImage
.SizeChanged.AddHandler (
512 let deltaX = args
.NewSize.Width - args
.PreviousSize.Width
513 let deltaY = args
.NewSize.Height - args
.PreviousSize.Height
514 adjustCurrentImageBorders deltaX deltaY
515 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (win.scrollViewCurrentImage
.HorizontalOffset + deltaX / 8.)
516 win.scrollViewCurrentImage
.ScrollToVerticalOffset (win.scrollViewCurrentImage
.VerticalOffset + deltaY / 8.)
519 let mutable maxScale = 4.
520 let mutable minScale = 0.25
521 let currentImageScaleTransform = ScaleTransform ()
522 win.canvasCurrentImage
.LayoutTransform <- currentImageScaleTransform
523 win.borderCurrentImage
.PreviewMouseWheel.AddHandler (
525 let scaleFactor = if args
.Delta > 0 then 2.0 else 0.5
526 if scaleFactor > 1. && currentScale < maxScale || scaleFactor < 1. && currentScale > minScale then
527 let previousScale = currentScale
529 let newScale = currentScale * scaleFactor
530 if newScale > maxScale then maxScale elif newScale < minScale then minScale else newScale
531 let realScaleFactor = currentScale / previousScale
533 let centerX = win.scrollViewCurrentImage
.HorizontalOffset + win.scrollViewCurrentImage
.ViewportWidth / 2. - win.borderCurrentImage
.BorderThickness.Left
534 let centerY = win.scrollViewCurrentImage
.VerticalOffset + win.scrollViewCurrentImage
.ViewportHeight / 2. - win.borderCurrentImage
.BorderThickness.Top
536 currentImageScaleTransform.ScaleX <- currentScale
537 currentImageScaleTransform.ScaleY <- currentScale
539 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (centerX * realScaleFactor - win.scrollViewCurrentImage
.ViewportWidth / 2. + win.borderCurrentImage
.BorderThickness.Left)
540 win.scrollViewCurrentImage
.ScrollToVerticalOffset (centerY * realScaleFactor - win.scrollViewCurrentImage
.ViewportHeight / 2. + win.borderCurrentImage
.BorderThickness.Top)
545 // Pan on the current image.
546 let mutable scrollStartPosition = Point (0., 0.)
547 let mutable scrollStartOffsetX = 0.
548 let mutable scrollStartOffsetY = 0.
549 win.borderCurrentImage
.PreviewMouseLeftButtonDown.AddHandler (
551 scrollStartPosition <- args
.GetPosition win.scrollViewCurrentImage
552 scrollStartOffsetX <- win.scrollViewCurrentImage
.HorizontalOffset
553 scrollStartOffsetY <- win.scrollViewCurrentImage
.VerticalOffset
554 win.borderCurrentImage
.Cursor <- Input.Cursors.ScrollAll
555 win.borderCurrentImage
.CaptureMouse () |> ignore
559 win.borderCurrentImage
.PreviewMouseMove.AddHandler (
561 if win.borderCurrentImage
.IsMouseCaptured then
562 let position = args
.GetPosition win.scrollViewCurrentImage
563 let deltaX = scrollStartPosition.X - position.X
564 let deltaY = scrollStartPosition.Y - position.Y
565 win.scrollViewCurrentImage
.ScrollToHorizontalOffset (deltaX + scrollStartOffsetX)
566 win.scrollViewCurrentImage
.ScrollToVerticalOffset (deltaY + scrollStartOffsetY)
571 win.borderCurrentImage
.PreviewMouseLeftButtonUp.AddHandler (
573 if win.borderCurrentImage
.IsMouseCaptured then
574 win.borderCurrentImage
.Cursor <- Input.Cursors.Arrow
575 win.borderCurrentImage
.ReleaseMouseCapture ()
581 win.InputBindings.Add (
583 ViewModule.FunCommand ((fun obj
-> saveCurrentDocument ()), (fun obj
-> true)),
584 Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control)
589 win.InputBindings.Add (
591 ViewModule.FunCommand ((fun obj
-> saveCurrentDocumentAsNewFile ()), (fun obj
-> true)),
592 Input.KeyGesture (Input.Key.S, Input.ModifierKeys.Control ||| Input.ModifierKeys.Shift)
597 win.InputBindings.Add (
599 ViewModule.FunCommand ((fun obj
-> askLoadFile ()), (fun obj
-> true)),
600 Input.KeyGesture (Input.Key.O, Input.ModifierKeys.Control)
605 win.InputBindings.Add (
607 ViewModule.FunCommand ((fun obj
-> newFile ()), (fun obj
-> true)),
608 Input.KeyGesture (Input.Key.N, Input.ModifierKeys.Control)
613 win.InputBindings.Add (
615 ViewModule.FunCommand ((fun obj
-> exportResults ()), (fun obj
-> true)),
616 Input.KeyGesture (Input.Key.E, Input.ModifierKeys.Control)
621 win.InputBindings.Add (
623 ViewModule.FunCommand ((fun obj
-> importImage ()), (fun obj
-> true)),
624 Input.KeyGesture (Input.Key.A, Input.ModifierKeys.Control)
628 // Show analysis dialog.
629 win.InputBindings.Add (
631 ViewModule.FunCommand ((fun obj
-> showAnalysisWindow ()), (fun obj
-> state.SourceImages.Count () > 0)),
632 Input.KeyGesture (Input.Key.Y, Input.ModifierKeys.Control)
636 // Toggle RBC highlight.
637 win.InputBindings.Add (
639 ViewModule.FunCommand (
642 win.menuHightlightRBC
.IsChecked <- not
win.menuHightlightRBC
.IsChecked
643 setHighlightRBC win.menuHightlightRBC
.IsChecked
647 Input.KeyGesture (Input.Key.H, Input.ModifierKeys.Control)
652 win.scrollViewCurrentImage
.ScrollChanged.AddHandler (fun obj args
-> updateViewportPreview ())
654 updateDocumentStatus ()
655 win.gridImageInformation
.Visibility <- Visibility.Hidden
659 match fileToOpen
with
660 | Some filepath
-> loadFile filepath