~ubuntu-branches/ubuntu/raring/mricron/raring

« back to all changes in this revision

Viewing changes to cropedges.pas

  • Committer: Bazaar Package Importer
  • Author(s): Michael Hanke
  • Date: 2010-07-29 22:07:43 UTC
  • Revision ID: james.westby@ubuntu.com-20100729220743-q621ts2zj806gu0n
Tags: upstream-0.20100725.1~dfsg.1
ImportĀ upstreamĀ versionĀ 0.20100725.1~dfsg.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
unit CropEdges;
 
2
 
 
3
{$mode objfpc}{$H+}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
 
9
  Spin, Buttons,nifti_img,define_types;
 
10
 
 
11
type
 
12
 
 
13
  { TCropEdgeForm }
 
14
 
 
15
  TCropEdgeForm = class(TForm)
 
16
    ApplyBtn: TSpeedButton;
 
17
    CropFileSzBtn: TSpeedButton;
 
18
    CancelBtn: TSpeedButton;
 
19
    Timer1: TTimer;
 
20
    DEdit: TSpinEdit;
 
21
    PEdit: TSpinEdit;
 
22
    AEdit: TSpinEdit;
 
23
    VEdit: TSpinEdit;
 
24
    REdit: TSpinEdit;
 
25
    LEdit: TSpinEdit;
 
26
    procedure ApplyCrop;
 
27
    procedure ApplyCrop2Img;
 
28
    procedure ApplyBtnClick(Sender: TObject);
 
29
    procedure CancelBtnClick(Sender: TObject);
 
30
    procedure CropEditChange(Sender: TObject);
 
31
    procedure CropFileSzBtnClick(Sender: TObject);
 
32
    procedure FormHide(Sender: TObject);
 
33
    procedure FormShow(Sender: TObject);
 
34
    procedure Timer1Timer(Sender: TObject);
 
35
  private
 
36
    { private declarations }
 
37
  public
 
38
    { public declarations }
 
39
  end; 
 
40
 
 
41
var
 
42
  CropEdgeForm: TCropEdgeForm;
 
43
 
 
44
implementation
 
45
uses
 
46
    nifti_img_view, crop;
 
47
{ TCropEdgeForm }
 
48
 
 
49
procedure TCropEdgeForm.ApplyBtnClick(Sender: TObject);
 
50
begin
 
51
        CropEdgeForm.ModalResult := mrOK;
 
52
        CropEdgeForm.close;
 
53
end;
 
54
 
 
55
procedure TCropEdgeForm.CancelBtnClick(Sender: TObject);
 
56
begin
 
57
        CropEdgeForm.close;
 
58
end;
 
59
 
 
60
procedure TCropEdgeForm.CropEditChange(Sender: TObject);
 
61
begin
 
62
     if not CropEdgeForm.visible then exit;
 
63
     Timer1.Enabled := true;
 
64
end;
 
65
 
 
66
 
 
67
procedure TCropEdgeForm.CropFileSzBtnClick(Sender: TObject);
 
68
  var
 
69
   lV,lD,lA,lP,lL,lR: integer;
 
70
begin
 
71
     lV := VEdit.value;
 
72
     lD := DEdit.value;
 
73
     lL := LEdit.value;
 
74
     lR := REdit.value;
 
75
     lA := AEdit.value;
 
76
     lP := PEdit.value;
 
77
     CropNIfTI(lL,lR,lA,lP,lD,lV);
 
78
end;
 
79
 
 
80
procedure TCropEdgeForm.FormHide(Sender: TObject);
 
81
begin
 
82
         UndoVolVOI;
 
83
         if not (CropEdgeForm.ModalResult = mrCancel) then
 
84
                ApplyCrop2Img
 
85
         else
 
86
             ImgForm.RefreshImagesTimer.Enabled := true;
 
87
end;
 
88
 
 
89
procedure TCropEdgeForm.FormShow(Sender: TObject);
 
90
begin
 
91
       EnsureVOIOpen;
 
92
     CreateUndoVol;
 
93
     CropEdgeForm.ModalResult := mrCancel;
 
94
     CropEditChange(nil);
 
95
end;
 
96
 
 
97
procedure TCropEdgeForm.ApplyCrop2Img;
 
98
var
 
99
        lZLo,lZHi,lXLo,lXHi,lYLo,lYHi,lPos,lX,lY,lZ: integer;
 
100
        l32Buf : SingleP;
 
101
        l16Buf : SmallIntP;
 
102
begin
 
103
     if (gMRIcroOverlay[kBGOverlayNum].ImgBufferItems<1) then exit;
 
104
     if (gBGImg.ScrnDim[1]*gBGImg.ScrnDim[2]*gBGImg.ScrnDim[3]) <> gMRIcroOverlay[kBGOverlayNum].ImgBufferItems then begin
 
105
        Showmessage('Can not crop edges of a rotated image.');
 
106
        exit;
 
107
     end;
 
108
     lXlo := round(LEdit.value);
 
109
     lXHi := gBGImg.ScrnDim[1] - round(REdit.value);
 
110
     lYlo := round(PEdit.value);
 
111
     lYHi := gBGImg.ScrnDim[2] - round(AEdit.value);
 
112
     lZLo := round(VEdit.value);
 
113
     lZHi := gBGImg.ScrnDim[3] - round(DEdit.value);
 
114
     lPos := 0;
 
115
     case gMRIcroOverlay[kBGOverlayNum].ImgBufferBPP of
 
116
      1: begin
 
117
           for lZ := 1 to gBGImg.ScrnDim[3] do
 
118
               for lY := 1 to gBGImg.ScrnDim[2] do
 
119
                   for lX := 1 to gBGImg.ScrnDim[1] do begin
 
120
                                inc(lPos);
 
121
                                if (lZ >= lZHi) or (lZ <= lZLo) or(lY >= lYHi) or (lY <= lYLo) or (lX >= lXHi) or (lX <= lXLo) then
 
122
                                  gMRIcroOverlay[kBGOverlayNum].ImgBuffer^[lPos] := 0;
 
123
                   end; //for X
 
124
           end;
 
125
      2: begin
 
126
           l16Buf := SmallIntP(gMRIcroOverlay[kBGOverlayNum].ImgBuffer );
 
127
           for lZ := 1 to gBGImg.ScrnDim[3] do
 
128
               for lY := 1 to gBGImg.ScrnDim[2] do
 
129
                   for lX := 1 to gBGImg.ScrnDim[1] do begin
 
130
                                inc(lPos);
 
131
                                if (lZ >= lZHi) or (lZ <= lZLo) or(lY >= lYHi) or (lY <= lYLo) or (lX >= lXHi) or (lX <= lXLo) then
 
132
                                  l16Buf^[lPos] := 0;
 
133
                   end; //for X
 
134
           end;
 
135
      4: begin
 
136
           l32Buf := SingleP(gMRIcroOverlay[kBGOverlayNum].ImgBuffer );
 
137
           for lZ := 1 to gBGImg.ScrnDim[3] do
 
138
               for lY := 1 to gBGImg.ScrnDim[2] do
 
139
                   for lX := 1 to gBGImg.ScrnDim[1] do begin
 
140
                                inc(lPos);
 
141
                                if (lZ >= lZHi) or (lZ <= lZLo) or(lY >= lYHi) or (lY <= lYLo) or (lX >= lXHi) or (lX <= lXLo) then
 
142
                                  l32Buf^[lPos] := 0;
 
143
                   end; //for X
 
144
           end;
 
145
       else begin showmessage('Unsupported data type'); end
 
146
     end; //case
 
147
     ImgForm.RescaleImagesTimer.Enabled := true;
 
148
end;
 
149
 
 
150
procedure TCropEdgeForm.ApplyCrop;
 
151
var
 
152
        lZLo,lZHi,lXLo,lXHi,lYLo,lYHi,lPos,lX,lY,lZ: integer;
 
153
begin
 
154
     if (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems<1) or (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems<>gBGImg.VOIUndoVolItems) then exit;
 
155
     if gBGImg.VOIUndoVolItems <> gMRIcroOverlay[kVOIOverlayNum].ScrnBufferItems then exit;
 
156
     if (gBGImg.ScrnDim[1]*gBGImg.ScrnDim[2]*gBGImg.ScrnDim[3]) <> gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems then exit;
 
157
     //CreateUndoVol;
 
158
     //Move(gBGImg.VOIUndoVol^,gMRIcroOverlay[kVOIOverlayNum].ScrnBuffer^,gBGImg.VOIUndoVolItems);
 
159
     FillChar(gMRIcroOverlay[kVOIOverlayNum].ScrnBuffer^,gBGImg.VOIUndoVolItems,0);
 
160
        lXlo := round(LEdit.value);
 
161
        lXHi := gBGImg.ScrnDim[1] - round(REdit.value);
 
162
        lYlo := round(PEdit.value);
 
163
        lYHi := gBGImg.ScrnDim[2] - round(AEdit.value);
 
164
        lZLo := round(VEdit.value);
 
165
        lZHi := gBGImg.ScrnDim[3] - round(DEdit.value);
 
166
        lPos := 0;
 
167
        for lZ := 1 to gBGImg.ScrnDim[3] do begin
 
168
                for lY := 1 to gBGImg.ScrnDim[2] do begin
 
169
                        for lX := 1 to gBGImg.ScrnDim[1] do begin
 
170
                                inc(lPos);
 
171
                                if (lZ >= lZHi) or (lZ <= lZLo) or(lY >= lYHi) or (lY <= lYLo) or (lX >= lXHi) or (lX <= lXLo) then
 
172
                                  gMRIcroOverlay[kVOIOverlayNum].ScrnBuffer^[lPos] := kVOI8bit;
 
173
                        end; //for X
 
174
                end; //for Y
 
175
        end; //for Z
 
176
        //gBGImg.VOIchanged := true;
 
177
        ImgForm.RefreshImagesTimer.enabled := true;
 
178
end;
 
179
 
 
180
procedure TCropEdgeForm.Timer1Timer(Sender: TObject);
 
181
begin
 
182
     Timer1.Enabled := false;
 
183
     ApplyCrop;
 
184
 
 
185
end;
 
186
 
 
187
 
 
188
 
 
189
 
 
190
initialization
 
191
  {$I cropedges.lrs}
 
192
 
 
193
end.
 
194