unit DynamicGrid;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.UITypes, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, CompoMansEh, Vcl.ExtCtrls,
PivotGridToolsEh, Data.DB, EhLibVCL, GridsEh, DBAxisGridsEh, DBVertGridsEh,
Vcl.StdCtrls, Vcl.DBCtrls, Data.Win.ADODB, DBGridEhGrouping, ToolCtrlsEh,
DBGridEhToolCtrls, DynVarsEh, DBGridEh, System.ImageList, Vcl.ImgList;
type
TDynamicGrid = class(TDBGridEh)
private
PanelOnGrid: TPanel ;
HighlightColor: TColor;
GlobalArrSList: TStringList;
FieldForPanel: String;
FieldForkey: String;
public
property FieldPanel : String read FieldForPanel write FieldForPanel;
property FieldKey : String read FieldForKey write FieldForKey;
property GridPanel : TPanel read PanelOnGrid write PanelOnGrid;
property HColor: TColor read HighlightColor write HighlightColor;
property GlobalArr: TStringList read GlobalArrSList write GlobalArrSList;
procedure ShowPanel(Sender: TCustomDBGridEh;
CursorPos: TPoint; Cell: TGridCoord; InCellCursorPos: TPoint;
Column: TColumnEh; var Params: TDBGridEhDataHintParams;
var Processed: Boolean);
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
end;
implementation
procedure TDynamicGrid.ShowPanel;
var
ScrPt, GrdPt: TPoint;
grCell: TGridCoord;
rect: TRect;
rectX, rectY : extended;
Name, ID: string;
begin
ScrPt := Mouse.CursorPos;
GrdPt := self.ScreenToClient(ScrPt);
grCell := self.MouseCoord(GrdPt.X, GrdPt.Y);
rect := self.CellRect(grCell.X, grCell.Y);
rectX := Rect.TopLeft.X + Rect.Width;
rectY := Rect.TopLeft.Y + Rect.Height/2 + Rect.Height - 1;
if grCell.Y = self.Row then
self.PanelOnGrid.Color := self.HColor
else
self.PanelOnGrid.Color := clWhite;
self.PanelOnGrid.Left := trunc(rectX - self.PanelOnGrid.Width/2);
self.PanelOnGrid.Top := trunc(rectY);
self.PanelOnGrid.Visible := true;
Name := self.DataSource.DataSet.FieldByName(self.FieldPanel).AsString;
ID := self.DataSource.DataSet.FieldByName(self.FieldKey).AsString;
self.GlobalArr.Values[self.FieldKey] := ID;
self.GlobalArr.Values[self.FieldPanel] := Name;
TForm(self.Parent).caption := 'Справочник: ' + Name;
end;
constructor TDynamicGrid.Create(AOwner: TComponent);
begin
inherited;
self.OnDataHintShow := showpanel;
end;
destructor TDynamicGrid.Destroy;
begin
inherited;
end;
end.procedure ShowPanel(Sender: TCustomDBGridEh;
CursorPos: TPoint; Cell: TGridCoord; InCellCursorPos: TPoint;
Column: TColumnEh; var Params: TDBGridEhDataHintParams;
var Processed: Boolean);procedure TDynamicGrid.ShowPanel;
var
begin
end;constructor TDynamicGrid.Create(AOwner: TComponent);
begin
inherited;
self.OnDataHintShow := showpanel;
end;type
TCrackDBGrid = class(TDBGridEh)
end;
...
var
MoveFlag: integer;
...
procedure TFSprav.DBGridEh2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
grCoord: TGridCoord;
aGrid: TCrackDBGrid;
NewActiveRecord, oldActiveRecord: integer;
delta: string;
begin
if MoveFlag <> 1 then
begin
MoveFlag := 1;
aGrid := TCrackDBGrid(Sender);
grCoord := aGrid.MouseCoord(X, Y);
aGrid.DataSource.DataSet.DisableControls;
oldActiveRecord := aGrid.DataLink.ActiveRecord;
newActiveRecord := grCoord.Y - aGrid.DataLink.ActiveRecord;
aGrid.DataLink.MoveBy(newActiveRecord);
delta := aGrid.DataLink.DataSet.FieldByName('Name').AsString;
if grCoord.X > 0 then
begin
caption := delta;
end;
aGrid.DataLink.ActiveRecord := oldActiveRecord;
aGrid.DataSource.DataSet.EnableControls;
MoveFlag := 0;
end;
end;
procedure TFSprav.dsMainCatDataChange(Sender: TObject; Field: TField);
begin
if MoveFlag = 0 then
begin
qCat.Active := false;
qCat.Parameters.ParamByName('id_MainCat').Value := dsMainCat.DataSet.FieldByName('id').AsInteger;
qCat.Active := true;
end;
end;Sub scan()
Dim objDM As WIA.DeviceManager
'MsgBox (Split(ActiveCell.Address, "$")(1))
Dim objDev As WIA.Device
Dim objItem As WIA.Item
Dim objImage, FirstImage As WIA.ImageFile
Dim objIP As WIA.ImageProcess
Dim s As String
Dim i, num As Integer
Set objDM = New WIA.DeviceManager
For i = 1 To objDM.DeviceInfos.Count
If objDM.DeviceInfos(i).Type = 1 Then
s = objDM.DeviceInfos(i).DeviceID
End If
Next
Set objDev = objDM.DeviceInfos(s).Connect
If objDev Is Nothing Then
MsgBox ("Error: Not device found")
Else
objDev.Properties("Document Handling Select").Value = 1
objDev.Properties("Pages").Value = 1
Set objItem = objDev.Items(1)
Set objImage = New WIA.ImageFile
Set objIP = New WIA.ImageProcess
ScanStart:
On Error GoTo ScanError
Set objImage = objItem.Transfer("{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}")
num = num + 1
If num = 1 Then
Set FirstImage = objImage
Else
objIP.Filters.Add (objIP.FilterInfos("Frame").FilterID)
objIP.Filters(objIP.Filters.Count).Properties("ImageFile") = objImage
objIP.Filters(objIP.Filters.Count).Properties("FrameIndex") = objIP.Filters.Count
End If
GoTo ScanStart
ScanError:
Select Case Err.Number
Case -2145320957
MsgBox ("No More Pages Found")
objIP.Filters.Add (objIP.FilterInfos("Convert").FilterID)
objIP.Filters(objIP.Filters.Count).Properties("FormatID") = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
Set FirstImage = objIP.Apply(FirstImage)
FirstImage.SaveFile "c:\test\" & ActiveCell.Value & num & ".TIFF"
Case Else
MsgBox ("Error: " & Err.Description & "(" & Err.Number & ")")
End Select
Set FirstImage = Nothing
Set objItem = Nothing
Set objImage = Nothing
Set objDev = Nothing
End If
Set objDev = Nothing
Set objDM = Nothing
End Sub