{ ==============================================================================
|
方法名稱:ShapeName2PreViewISBName
|
引用相依:
|
方法描述:將 TShape 元件的名稱轉換為對應的預覽影像捲軸盒(PreViewISB)名稱。
|
============================================================================== }
|
Function TCB_IMGPSScanX.ShapeName2PreViewISBName(SP:TShape):String; //轉出指定PreViewISBName
|
begin
|
Result := ISBName+Copy(SP.Name,3,length(SP.Name)-2);
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:CreatePreViewISB
|
引用相依:
|
方法描述:動態建立指定數量的縮圖預覽組件。首先清空既有的預覽組件,接著在 ScrollB
|
ox1 中為每個縮圖建立一個 TPanel 作為容器,並在其內嵌入一個 TImageScro
|
llBox。設定組件的對齊方式、預設縮放模式及多項事件處理函式(如 Click, Mo
|
useMove, DragDrop 等),並掛載右鍵選單。
|
============================================================================== }
|
Procedure TCB_IMGPSScanX.CreatePreViewISB(Count:Integer);
|
var
|
ISB : TImageScrollBox;
|
Panel : TPanel;
|
i,W,H : Integer;
|
myDate : TDateTime;
|
begin
|
FreePreViewISB;
|
ScrollBox1.HorzScrollBar.Visible := False;
|
W := 150;
|
H := 250;
|
for I := 1 to Count do
|
begin
|
|
if FindComponent('M_Pl'+inttostr(i))=nil then
|
begin
|
Panel := TPanel.Create(Self);
|
Panel.Name := 'M_Pl'+inttostr(i);//FormatDateTime('yyyymmddhhnnsszzz', now)
|
Panel.Left := 4;
|
Panel.Top := (i-1)*H+(6*i);
|
Panel.Height := H;
|
Panel.Width := W;
|
Panel.Parent := ScrollBox1;
|
Panel.Caption :='';
|
|
if FindComponent(ISBName+inttostr(i))=nil then
|
begin
|
ISB := TImageScrollBox.Create(Self);
|
ISB.Name := ISBName+inttostr(i);
|
ISB.Parent := Panel;
|
ISB.Align := alClient;
|
ISB.ZoomMode := zmFullPage;
|
ISB.DragMode := dmAutomatic;
|
ISB.MouseMode := mmuser;
|
ISB.OnImageClick := ISBClick;
|
ISB.OnImageMouseMove := ISBMouseMove;
|
ISB.PopupMenu := PopupMenu6;
|
ISB.OnImageMouseDown := ISBImageMouseDown;
|
ISB.OnImageMouseUp := ISBImageMouseUp;
|
ISB.OnEndDrag := ISBEndDrag;
|
ISB.OnDragDrop := ISBDragDrop;
|
ISB.OnDragOver := ISBDragOver;
|
end;
|
end;
|
|
end;
|
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:FreePreViewISB
|
引用相依:
|
方法描述:釋放所有與縮圖預覽相關的動態組件。遍歷所有組件,尋找名稱中包含特定前綴
|
(如 ISBName, M_Pl, SP)的 TImageScrollBox、TPanel 與 TShape 並執行 Fre
|
e 動作。最後呼叫 ProcessMessages 確保 UI 資源正確釋放。
|
============================================================================== }
|
Procedure TCB_IMGPSScanX.FreePreViewISB;
|
var
|
i : Integer;
|
begin
|
try
|
For i:= ComponentCount -1 downto 0 do
|
begin
|
IF (Components[i] is TImageScrollBox) and (Components[i]<>nil) Then
|
begin
|
IF Pos(ISBName,Components[i].Name) > 0 Then
|
Components[i].Free;
|
end
|
Else If (Components[i] is TPanel) and (Components[i]<>nil) Then
|
begin
|
IF Pos('M_Pl',Components[i].Name) > 0 Then
|
Components[i].Free;
|
end
|
Else If (Components[i] is TShape) and (Components[i]<>nil) Then
|
begin
|
IF Pos('SP',Components[i].Name) > 0 Then
|
Components[i].Free;
|
end;
|
end;
|
Application.ProcessMessages;
|
except on E: Exception do
|
end;
|
|
//showmessage(inttostr(Count));
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:FitPreViewISB
|
引用相依:
|
方法描述:自動調整所有預覽縮圖面板的高度與位置。遍歷所有已建立的預覽組件(ISB),
|
根據每個影像實際顯示的高度(DisplayedGraphic.Height)動態設定其父面板
|
的高度,並依序由上而下排列,確保縮圖之間緊密銜接。
|
============================================================================== }
|
Procedure TCB_IMGPSScanX.FitPreViewISB;
|
var
|
i : Integer;
|
iISB : TImageScrollBox;
|
iPanel : TPanel;
|
T,H : Integer;
|
begin
|
T := 0;
|
i := 1;
|
|
while FindComponent(ISBName+inttostr(i)) <> nil do
|
begin
|
iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
|
iISB.Parent.Height := 250;
|
iISB.Parent.Top := T+4;
|
iISB.Parent.Height := iISB.DisplayedGraphic.Height;
|
H := iISB.Parent.Height;
|
T := iISB.Parent.Top+H;
|
inc(i);
|
end;
|
|
|
{For i:= 1 to Count do
|
begin
|
if TImageScrollBox(FindComponent(ISBName+inttostr(i))) = nil then Break;
|
|
|
iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
|
iISB.Parent.Height := H;
|
iISB.Parent.Top := T+4;
|
iISB.Parent.Height := iISB.DisplayedGraphic.Height;
|
H := iISB.Parent.Height;
|
T := iISB.Parent.Top+H;
|
end;}
|
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:PaintShape
|
引用相依:
|
方法描述:在預覽縮圖周圍繪製藍色選取框(TShape)。若僅傳入單一影像(ToImg 為 nil),
|
則只在該影像位置建立選取框;若傳入起點與終點影像,則會在範圍內的所有影
|
像組件上建立選取框。框線寬度設為 3 且顏色為藍色,用於視覺化標記選取狀
|
態。
|
============================================================================== }
|
Procedure TCB_IMGPSScanX.PaintShape(FromImg,ToImg:TImageScrollBox); //畫有被選取的影像
|
var
|
i,F_No,T_No : Integer;
|
SP : TShape;
|
ISB : TImageScrollBox;
|
Function GetImgNo(iISB:TImageScrollBox):Integer;
|
begin
|
Result := strtoint(Copy(iISB.Name,length(ISBName)+1,length(iISB.Name)-length(ISBName))); //'PreViewISB'
|
end;
|
begin
|
IF ToImg = nil Then //只畫單一個
|
begin
|
ISB := TImageScrollBox(FindComponent(ISBName+inttostr(GetImgNo(FromImg))));
|
if TShape(FindComponent('SP'+inttostr(GetImgNo(FromImg)))) = nil then
|
begin
|
|
SP := TShape.Create(self);
|
SP.Pen.Color := clblue;
|
SP.Pen.Width := 3;
|
SP.Parent := ScrollBox1;
|
SP.Name := 'SP'+inttostr(GetImgNo(FromImg));
|
SP.Left := ISB.Parent.Left-4;
|
SP.Top := ISB.Parent.Top -4;
|
SP.Width := ISB.Parent.Width + 8;
|
SP.Height := ISB.Parent.Height + 8;
|
end;
|
end
|
Else
|
begin
|
FreeShapeobj(nil);
|
IF GetImgNo(FromImg) <= GetImgNo(ToImg) Then
|
begin
|
F_No := GetImgNo(FromImg);
|
T_No := GetImgNo(ToImg);
|
end
|
Else
|
begin
|
F_No := GetImgNo(ToImg);
|
T_No := GetImgNo(FromImg);
|
end;
|
For i := F_No to T_No do
|
begin
|
ISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
|
SP := TShape.Create(self);
|
SP.Pen.Color := clblue;
|
SP.Pen.Width := 3;
|
SP.Parent := ScrollBox1;
|
SP.Name := 'SP'+inttostr(i);
|
SP.Left := ISB.Parent.Left-4;
|
SP.Top := ISB.Parent.Top -4;
|
SP.Width := ISB.Parent.Width + 8;
|
SP.Height := ISB.Parent.Height + 8;
|
end;
|
end;
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:FreeShapeobj
|
引用相依:
|
方法描述:刪除縮圖上的選取標記(TShape)。若傳入的 SelectISB 為 nil,則會刪除所有
|
名稱前綴為 "SP" 的選取框組件;若指定了特定的影像組件,則僅刪除與該影像
|
對應的選取框。
|
============================================================================== }
|
Procedure TCB_IMGPSScanX.FreeShapeobj(SelectISB : TImageScrollBox);
|
var
|
i : Integer;
|
begin
|
IF SelectISB = nil then //全Free;
|
begin
|
For i:= ComponentCount -1 downto 0 do
|
begin
|
IF Components[i] is TShape Then
|
begin
|
IF Pos('SP',Components[i].Name) > 0 Then
|
Components[i].Free;
|
end;
|
end;
|
end
|
Else //只Free指定的
|
begin
|
TShape(FindComponent('SP'+Copy(SelectISB.Name,length(ISBName)+1,length(SelectISB.Name)-length(ISBName)))).Free;
|
end;
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:ISBClick
|
引用相依:Image_Smooth, LoadFromFile
|
方法描述:處理縮圖點擊事件,支援組合鍵選取。若按下 Shift 鍵則執行連選(PaintShape
|
範圍選取);若按下 Control 鍵則切換單選狀態;一般點擊則清除舊選取並重
|
新標記。點擊後會從選取的縮圖載入原圖至主顯示區(ISB1),並視需要執行影像
|
平滑化處理。
|
============================================================================== }
|
Procedure TCB_IMGPSScanX.ISBClick(Sender : TObject);
|
var
|
v,ln:Integer;
|
begin
|
if (GetKeyState(VK_SHIFT) < 0) Then
|
begin
|
PaintShape(SelectISB,TImageScrollBox(Sender));
|
SelectISB := TImageScrollBox(Sender);
|
end
|
Else if (GetKeyState(VK_CONTROL) < 0) Then
|
begin
|
SelectISB := TImageScrollBox(Sender);
|
IF TShape(FindComponent('SP'+Copy(SelectISB.Name,length(ISBName)+1,length(SelectISB.Name)-length(ISBName)))) = nil Then
|
PaintShape(SelectISB,nil)
|
else
|
FreeShapeobj(SelectISB);
|
end
|
Else
|
begin
|
FreeShapeobj(nil);
|
SelectISB := TImageScrollBox(Sender);
|
PaintShape(SelectISB,nil);
|
end;
|
GetSelectImageFile;
|
|
v := length(ISBName);
|
ln := length(SelectISB.Name);
|
SelectPage := Strtoint(Copy(SelectISB.Name,v+1,ln-v));
|
ISB1.ZoomMode := zmFittoPage;
|
//ShowMessage('SelectISB.FileName='+SelectISB.FileName);
|
//if SelectISB.FileName='' then exit;
|
|
ISB1.LoadFromFile(SelectISB.FileName,1);
|
if (ISB1.Graphic.ImageFormat <> ifBlackWhite) and (SmoothCB.Checked)then
|
Image_Smooth(ISB1.Graphic);
|
ISB1.Redraw(True);
|
ISB1Click(ISB1);
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:ISBMouseMove
|
引用相依:
|
方法描述:處理縮圖區的滑鼠移動事件。當處於拖曳狀態且滑鼠移動至已選取的影像(有 S
|
P 標記)時,觸發組件的 BeginDrag 開始執行拖放操作。
|
============================================================================== }
|
Procedure TCB_IMGPSScanX.ISBMouseMove(Sender: TObject; Shift: TShiftState;
|
X, Y: Integer);
|
begin
|
//Edit1.SetFocus;
|
if Draging then
|
begin
|
if not (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
|
begin
|
SelectISB.BeginDrag(False);
|
Draging := False;
|
end;
|
end;
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:ISBImageMouseDown
|
引用相依:LoadFromFile
|
方法描述:處理縮圖預覽影像的滑鼠按下事件。當按下左鍵時,將 Draging 標記設為 True
|
以利後續拖曳判斷。若未處於拖曳中,則根據是否按下 Shift 或 Control 鍵,
|
執行範圍選取、加選或單選操作。選取後會更新 SelectPage,並在主顯示區(ISB
|
1)同步載入對應的影像檔案。
|
============================================================================== }
|
procedure TCB_IMGPSScanX.ISBImageMouseDown(Sender: TObject; Button: TMouseButton;
|
Shift: TShiftState; X, Y: Integer);
|
var
|
v,ln:Integer;
|
begin
|
if Button = TMouseButton(mbLeft) Then
|
begin
|
Draging := True;
|
//if SelectISB <> nil then
|
|
//if not Draging then
|
//begin
|
|
end;
|
//end;
|
|
{if not (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
|
begin
|
//Showmessage('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)));
|
if (Button = TMouseButton(mbLeft)) and (GetKeyState(VK_CONTROL) >= 0) then
|
begin
|
if SelectISB <> nil then
|
SelectISB.BeginDrag(False);
|
end;
|
end;
|
//if (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
|
//begin
|
//else
|
//begin
|
if not Draging then
|
begin
|
if (GetKeyState(VK_SHIFT) < 0) Then
|
begin
|
PaintShape(SelectISB,TImageScrollBox(Sender));
|
SelectISB := TImageScrollBox(Sender);
|
end
|
Else if (GetKeyState(VK_CONTROL) < 0) Then
|
begin
|
SelectISB := TImageScrollBox(Sender);
|
IF TShape(FindComponent('SP'+Copy(SelectISB.Name,length(ISBName)+1,length(SelectISB.Name)-length(ISBName)))) = nil Then
|
PaintShape(SelectISB,nil)
|
else
|
FreeShapeobj(SelectISB);
|
end
|
Else
|
begin
|
FreeShapeobj(nil);
|
SelectISB := TImageScrollBox(Sender);
|
PaintShape(SelectISB,nil);
|
end;
|
v := length(ISBName);
|
ln := length(SelectISB.Name);
|
SelectPage := Strtoint(Copy(SelectISB.Name,v+1,ln-v));
|
ISB1.ZoomMode := zmFittoPage;
|
ISB1.LoadFromFile(SelectISB.FileName,1);
|
ISB1Click(ISB1);
|
end;
|
//end;
|
//end
|
//Else
|
//begin
|
|
//end; }
|
|
{if (Button = TMouseButton(mbRight)) and (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
|
begin
|
//ISBClick(Sender);
|
end;
|
if (Button = TMouseButton(mbLeft)) then
|
begin
|
|
end; }
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:ISBImageMouseUp
|
引用相依:
|
方法描述:處理縮圖預覽影像的滑鼠放開事件,將拖曳標記 Draging 重置為 False。
|
============================================================================== }
|
procedure TCB_IMGPSScanX.ISBImageMouseUp(Sender: TObject; Button: TMouseButton;
|
Shift: TShiftState; X, Y: Integer);
|
begin
|
Draging := False;
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:ISBEndDrag
|
引用相依:
|
方法描述:當影像拖放操作結束時,觸發 TreeView1Click 事件以更新樹狀結構與顯示介
|
面。
|
============================================================================== }
|
procedure TCB_IMGPSScanX.ISBEndDrag(Sender, Target: TObject; X, Y: Integer);
|
begin
|
TreeView1Click(self);
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:ISBDragDrop
|
引用相依:
|
方法描述:執行縮圖拖放後的影像移動操作。根據來源與目標影像的原始掃描頁碼,呼叫 M
|
oveImage_Drag 調整檔案在目錄中的順序。
|
============================================================================== }
|
procedure TCB_IMGPSScanX.ISBDragDrop(Sender, Source: TObject; X, Y: Integer);
|
var
|
fp,tp : Integer;
|
begin
|
fp := FileName2ScanPage(TimageScrollBox(Source).FileName);
|
tp := FileName2ScanPage(TimageScrollBox(Sender).FileName);
|
MoveImage_Drag(DisplayPath+NowDocDir+'\',fp,tp );
|
|
end;
|
|
|
{ ==============================================================================
|
方法名稱:ISBDragOver
|
引用相依:
|
方法描述:判斷拖放操作是否可接受。僅在來源為影像組件、檔案路徑不同且樹狀結構選取
|
在文件層級(Level 2)時,才允許執行拖放。
|
============================================================================== }
|
procedure TCB_IMGPSScanX.ISBDragOver(Sender, Source: TObject; X, Y: Integer;
|
State: TDragState; var Accept: Boolean);
|
var
|
So : Boolean;
|
begin
|
{if (TObject(Source) is TImageScrollBox) and (TObject(Sender) is TImageScrollBox) then
|
begin
|
Label3.Caption := TImageScrollBox(Source).FileName+#13+TImageScrollBox(Sender).FileName;
|
end; }
|
|
So := False;
|
if TObject(Source) is TImageScrollBox then
|
So := True;
|
Accept := True;
|
if not So
|
or (TImageScrollBox(Source).FileName = TImageScrollBox(Sender).FileName)
|
or (TreeView1.Selected.Level <> 2)
|
Then
|
Accept := False;
|
end;
|