unit AutoPanel; interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs, ExtCtrls,dbctrls,stdctrls,db,ADODB,ComCtrls,Variants,Gauges, SqlExpr,DBGrids,MovePanel; type TEditorstyle = (TsMemo,Tscombox,Tsedit); type TAutoPanel = class(TPanel) private { Private declarations } FEditorstyle:Teditorstyle; FLeft :Integer; FTop :Integer; maxTextLen :Integer; maxLabelLen :Integer; FTitleVisible :Boolean; FDataReadOnly :Boolean; FPageCount :Integer; FPass_Grid :TDBGrid; FP_Move :TMovePanel; FP_Parent :TPanel; FPageControl: TPageControl; {分页控件} FTabSheets :array of TTabSheet; FScrollBox :array of TScrollBox; {滚动控件} FLineHeight :Integer; //数据数组控件，动态生成 MemoEditors :array of TMemo; comEditors :array of TCombobox; edEditors :array of Tedit; ProgressEditor :array of Tedit; Labels :array of TLabel; //字段标题，动态生成 ProgressBars :array of TGauge; Shapes :array of TShape; FDataSource :TDataSource; // 数据源 FDataField_A :String; // DataField FDataField_B :String; // DataField FDataField_C :String; // DataField FDataField_D :String; // DataField FDataField_E :String; // DataField FDataField_F :String; // DataField FStore :String; Fcnnstr :String; FListSql :String; FBerthFieldName :String; FStoreFieldName :String; FBerthTableName :String; FColumns :Integer; //显示列数 tmpado :TadoDataset; tmpDs :TDataSource; procedure FreeEditors; //释放数据输入控件的内存 procedure AKeyDown(Sender:TObject; var Key :Word; Shift:TShiftState); procedure AKeyPress(Sender:TObject; var Key :Char); procedure AProgressEditorChange(Sender :TObject); procedure inti_Grid(sender :TObject); procedure LabelsClick(Sender: TObject); procedure FP_MovePanelDblClick(Sender: TObject); function comEditor(Index :Integer):TComboBox; function edEditor(Index :Integer):Tedit; function MemoEditor(Index :Integer) :TMemo; protected { Protected declarations } public constructor Create(AOwner:TComponent); override; destructor Destroy; override; procedure Setedit(Value :TEditorstyle); procedure CreateEditors(var DS :TDataSource; cnnstr :String); //创建各字段的数据输入控件 procedure ClearHits(ItemIndex :Integer); procedure AddHits(ItemIndex:Integer; Hits :array of string); { Public declarations } published property LimitLeft :Integer read FLeft write FLeft default 10; property LimitTop :Integer read FTop write FTop default 10; property Editorstyle :TEditorstyle read FEditorstyle write Setedit default TsMemo; property EditorWidth :Integer read maxTextLen write maxTextLen default 100; property TitleWidth :Integer read maxLabelLen write maxLabelLen default 100; property TitleVisible :Boolean read FTitleVisible write FTitleVisible default True; property DataReadOnly :Boolean read FDataReadOnly write FDataReadOnly; //default True; property LineHeight :Integer read FLineHeight write FLineHeight default 15; property DataSource :TDataSource read FDataSource write FDataSource; //数据源 property DataField_Editor :String read FDataField_A write FDataField_A; property DataField_Title :String read FDataField_B write FDataField_B; property DataField_Progress :String read FDataField_C write FDataField_C; property DataField_BerthArea :String read FDataField_D write FDataField_D; property DataField_IconLeft :String read FDataField_E write FDataField_E; property DataField_IconTop :String read FDataField_F write FDataField_F; property Data_BerthListSql :String read FListSql write FListSql; property Data_BerthField :String read FBerthFieldName write FBerthFieldName; property Data_StoreField :String read FStoreFieldName write FStoreFieldName; property Data_BerthTable :String read FBerthTableName write FBerthTableName; property Store_Name :String read FStore write FStore; property Columns :Integer read FColumns write FColumns default 4;//表列数 { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents('Data Controls', [TAutoPanel]); end; procedure TAutoPanel.Setedit(Value :TEditorstyle); begin if FEditorstyle <> Value then begin FEditorstyle := Value; Invalidate; end; end; { 为第I字段增加提示信息的方法} procedure TAutoPanel.AddHits(ItemIndex :Integer; Hits :array of string); var m,n,i :Integer; begin if FEditorstyle = Tscombox then begin n := Length(comEditors); m := Length(Hits); if ItemIndex< n then for i:= 0 to m - 1 do comEditors[ItemIndex].Items.Add(Hits[i]); end else if FEditorstyle = Tsedit then begin n := Length(edEditors); m := Length(Hits); if ItemIndex< n then for i:=0 to m-1 do edEditors[ItemIndex].Hint:= Hits[i]; end else if FEditorstyle = TsMemo then begin n := Length(memoEditors); m := Length(Hits); if ItemIndex< n then for i:=0 to m-1 do memoEditors[ItemIndex].Hint:= Hits[i]; end; end; procedure TAutoPanel.AKeyDown(Sender :TObject; var Key :Word; Shift :TShiftState); begin // end; procedure TAutoPanel.AProgressEditorChange(Sender :TObject); begin // end; procedure TAutoPanel.AKeyPress(Sender :TObject; var Key :Char); begin if (Sender is TComboBox) or (Sender is Tedit) or (Sender is TMemo) then if Key=#13 then (Owner as TForm).Perform(WM_NEXTDLGCTL, 0, 0); end; procedure TAutoPanel.ClearHits(ItemIndex :Integer); var n :Integer; begin if FEditorstyle = Tscombox then begin n := Length(comEditors); if ItemIndex< n then comEditors[ItemIndex].Items.Clear; end else if FEditorstyle = Tsedit then begin n := Length(edEditors); if ItemIndex< n then edEditors[ItemIndex].Hint:='';; end else if FEditorstyle = TsMemo then begin n := Length(MemoEditors); if ItemIndex< n then MemoEditors[ItemIndex].Hint:='';; end; end; constructor TAutoPanel.Create(AOwner :TComponent); begin Inherited Create(AOWner); FLeft := 20; FTop := 20; maxTextLen := 100; maxLabelLen := 100; FLineHeight := 15; FTitleVisible := True; FDataReadOnly := True; end; { 创建各字段的数据输入控件的方法} procedure TAutoPanel.CreateEditors(var DS :TDataSource; cnnstr :String); var i,j,n,This_Index,TextHeight :Integer; tmp_col0,Tmp_Row0,tmp_col1,Tmp_Row1 :Integer; XXX :TStringList; tmpFlag :Boolean; begin if (Store_Name = '') or (Data_BerthTable = '') or (DataField_BerthArea = '') then exit; { 释放全部控件内存} FreeEditors; if DS = nil then exit; if DataSource = nil then FDataSource := Ds; if not DataSource.DataSet.Active then exit; if (DataSource.DataSet is TAdoDataSet) = False then exit; FPageCount := 0; tmp_col1 := -1; Tmp_Row1 := 0; n := DataSource.DataSet.RecordCount; if n <= 0 then exit; DataSource.DataSet.DisableControls; if maxLabelLen < maxTextLen then maxTextLen := maxLabelLen; { 计算最大的标题长度及显示长度} DataSource.DataSet.First; { 计算高度} TextHeight := Canvas.TextHeight(DataSource.DataSet.Fields[0].DisplayLabel) + FLineHeight; //10; { 分配内存} SetLength(Labels,n); SetLength(ProgressBars,n); SetLength(ProgressEditor,n); SetLength(Shapes,n); if Columns = 0 then Columns := 6; try tmpado := TadoDataset.Create(Owner); tmpDs := TDatasource.Create(Owner); tmpDs.DataSet := tmpado; with tmpado do begin Active := False; Fcnnstr := cnnstr; tmpado.ConnectionString := Fcnnstr; //tmpado.Connection := (DataSource.DataSet as TAdoDataset).Connection; tmpado.CommandText := ' Select '+DataField_BerthArea+' ' + ' from '+Data_BerthTable+' where '+DataField_BerthArea+' is not null' + ' and '+Data_StoreField+' = '''+Store_Name+'''' + ' Group by '+DataField_BerthArea+' order by '+DataField_BerthArea+''; Active := True; FPageCount := RecordCount; if FPageCount = 0 then exit; first; // 创建PageControl FPageControl := TPageControl.Create(Owner); FPageControl.Parent := Self; FPageControl.Font.Name := '宋体'; FPageControl.Font.Size := 9; FPageControl.Align := alClient; FPageControl.Visible := False; { 分配载体内存} setlength(FTabSheets,FPageCount+1); setlength(FScrollBox,FPageCount+1); XXX := TStringList.Create(); for j := 0 to FPageCount do begin { FPageControl分页} FTabSheets[j] := TTabSheet.Create(Owner); FTabSheets[j].Parent := FPageControl; FTabSheets[j].ParentFont := True; FTabSheets[j].PageControl := FPageControl; FTabSheets[j].Visible := True; FTabSheets[j].PageIndex := j; if j < FPageCount then begin FTabSheets[j].Caption := '库区：' + trim(fieldByName(DataField_BerthArea).AsString); FTabSheets[j].Hint := trim(fieldByName(DataField_BerthArea).AsString); XXX.Append(trim(fieldByName(DataField_BerthArea).AsString)); end else begin FTabSheets[j].Caption := '未指定库区'; FTabSheets[j].Hint := ''; XXX.Append('未指定库区'); end; FTabSheets[j].ShowHint := False; FTabSheets[j].Visible := True; FTabSheets[j].Align := alClient; //创建滚动盒 FScrollBox[j] := TScrollBox.Create(Owner); FScrollBox[j].Visible := True; FScrollBox[j].Parent := FTabSheets[j]; FScrollBox[j].Color := ClBlack;//clTeal; FScrollBox[j].Align := alClient; FScrollBox[j].Hint := FTabSheets[j].Hint; FScrollBox[j].ShowHint := False; next; end; end; if FEditorstyle = Tscombox then SetLength(comEditors,n) else if FEditorstyle = Tsedit then SetLength(edEditors,n) else SetLength(MemoEditors,n); { 创建编辑} for i := 0 to n - 1 do begin //DataField_BerthArea if DataSource.DataSet.Fieldbyname(DataField_BerthArea).AsVariant = null then This_Index := FPageCount else This_Index := XXX.IndexOf(trim(DataSource.DataSet.Fieldbyname(DataField_BerthArea).Asstring)); tmpFlag := False; if DataSource.DataSet.Fieldbyname(DataField_IconLeft).AsVariant <> null then tmp_col0 := DataSource.DataSet.Fieldbyname(DataField_IconLeft).Asinteger -1 else begin tmpFlag := True; if tmp_col1 = Columns -1 then begin tmp_col1 := 0; tmp_Row1 := tmp_Row1 +1; end else tmp_col1 := tmp_col1 + 1; tmp_col0 := tmp_col1; This_Index := FPageCount; end; if DataSource.DataSet.Fieldbyname(DataField_IconTop).AsVariant <> null then tmp_Row0 := DataSource.DataSet.Fieldbyname(DataField_IconTop).Asinteger - 1 else begin if not tmpFlag then begin if tmp_col1 = Columns - 1 then begin tmp_col1 := 0; tmp_Row1 := tmp_Row1 +1; end else tmp_col1 := tmp_col1 + 1; end; tmp_Row0 := tmp_Row1; This_Index := FPageCount; end; { 创建标题} Labels[i] := TLabel.Create(owner); Labels[i].visible := FTitleVisible; Labels[i].Parent := (FScrollBox[This_Index] as TScrollBox); // FScrollBox[This_Index]; Labels[i].Font.Name := '宋体'; Labels[i].Font.Size := 9; Labels[i].Font.Color := ClBlue; Labels[i].OnClick := LabelsClick; //Labels[i].Font.Style := [FsBold]; Labels[i].Transparent := True; if DataSource.DataSet.Fieldbyname(DataField_Title).AsVariant <> null then Labels[i].caption := DataSource.DataSet.Fieldbyname(DataField_Title).AsString else Labels[i].caption := ''; Labels[i].Hint := '库位：[' + Labels[i].caption + ']'; Labels[i].ShowHint := True; if FEditorstyle = TsMemo then begin Labels[i].Top := FTop + tmp_Row0 * (TextHeight*3+30) + 2; Labels[i].Left := FLeft + (maxLabelLen + 40) * tmp_Col0 + 10; Labels[i].Width := maxLabelLen; end else begin Labels[i].Top := FTop + tmp_Row0 * (TextHeight*2+30) + 2; Labels[i].Left := FLeft + (maxLabelLen + 30) * tmp_Col0 + 10; Labels[i].Width := maxLabelLen; end; { 创建进度条数据对象} ProgressEditor[i] := Tedit.Create(Owner); ProgressEditor[i].visible := False; ProgressEditor[i].Parent := FScrollBox[This_Index]; if DataSource.DataSet.Fieldbyname(DataField_Progress).AsVariant <> null then ProgressEditor[i].Text := DataSource.DataSet.Fieldbyname(DataField_Progress).AsString else ProgressEditor[i].Text := '0'; ProgressEditor[i].OnChange := AProgressEditorChange; { 创建信息显示数据对象} if FEditorstyle = Tscombox then begin comEditors[i] := TComboBox.Create(Owner); comEditors[i].Parent := FScrollBox[This_Index]; //Self; comEditors[i].Left := Labels[i].Left; //+ Labels[i].Width; comEditors[i].Width := maxTextLen; comEditors[i].Top := Labels[i].Top+20; if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then comEditors[i].Text := DataSource.DataSet.Fieldbyname(DataField_Editor).AsString; comEditors[i].OnKeyPress := AKeyPress; comEditors[i].OnKeyDown := AKeyDown; ProgressBars[i] := TGauge.Create(Owner); ProgressBars[i].Parent := FScrollBox[This_Index]; ProgressBars[i].Font.name := '宋体'; ProgressBars[i].Font.Size := 9; ProgressBars[i].ShowText := True; ProgressBars[i].Font.Color := ClWindow; ProgressBars[i].Kind := gkHorizontalBar; ProgressBars[i].Left := comEditors[i].Left; ProgressBars[i].Width := comEditors[i].Width; ProgressBars[i].Height := 10; ProgressBars[i].Top := comEditors[i].Top+comEditors[i].height+2; ProgressBars[i].Progress := Round((DataSource.DataSet .Fieldbyname(DataField_Progress).Ascurrency)*100); end else if FEditorstyle = Tsedit then begin edEditors[i] := Tedit.Create(Owner); edEditors[i].Parent := FScrollBox[This_Index]; edEditors[i].Left := Labels[i].Left; //+ Labels[i].Width; edEditors[i].Width := maxTextLen; edEditors[i].Top := Labels[i].Top+20; edEditors[i].ReadOnly := DataReadOnly; if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then edEditors[i].Text := DataSource.DataSet.Fieldbyname(DataField_Editor).AsString; edEditors[i].OnKeyPress := AKeyPress; edEditors[i].OnKeyDown := AKeyDown; ProgressBars[i] := TGauge.Create(Owner); ProgressBars[i].Parent := FScrollBox[This_Index]; ProgressBars[i].Font.name := '宋体'; ProgressBars[i].Font.Size := 9; ProgressBars[i].ShowText := True; ProgressBars[i].Font.Color := ClWindow; ProgressBars[i].Kind := gkHorizontalBar; ProgressBars[i].Left := edEditors[i].Left; ProgressBars[i].Width := edEditors[i].Width; ProgressBars[i].Height := 10; ProgressBars[i].Top := edEditors[i].Top+edEditors[i].height+2;; ProgressBars[i].Progress := Round((DataSource.DataSet .Fieldbyname(DataField_Progress).Ascurrency)*100); end else begin MemoEditors[i] := Tmemo.Create(Owner); MemoEditors[i].Parent := FScrollBox[This_Index]; MemoEditors[i].Left := Labels[i].Left; MemoEditors[i].Width := maxTextLen; MemoEditors[i].Top := Labels[i].Top+20; MemoEditors[i].Height := 60; MemoEditors[i].ReadOnly := DataReadOnly; if DataSource.DataSet.Fieldbyname(DataField_Editor).AsVariant <> null then MemoEditors[i].Lines.Add(DataSource.DataSet.Fieldbyname(DataField_Editor).AsString); MemoEditors[i].OnKeyPress := AKeyPress; MemoEditors[i].OnKeyDown := AKeyDown; ProgressBars[i] := TGauge.Create(Owner); ProgressBars[i].Parent := FScrollBox[This_Index]; ProgressBars[i].Font.name := '宋体'; ProgressBars[i].Font.Size := 9; ProgressBars[i].ShowText := False; ProgressBars[i].Font.Color := ClWindow; ProgressBars[i].Kind := gkVerticalBar; ProgressBars[i].Left := MemoEditors[i].Left + MemoEditors[i].Width +1; ProgressBars[i].Width := 10; ProgressBars[i].Height := MemoEditors[i].Height; ProgressBars[i].Top := MemoEditors[i].Top; ProgressBars[i].Progress := Round((DataSource.DataSet .Fieldbyname(DataField_Progress).Ascurrency)*100); end; if ProgressBars[i].Progress <= 20 then ProgressBars[i].ForeColor := RGB(48,48,96) else if (ProgressBars[i].Progress > 20) and (ProgressBars[i].Progress <= 40) then ProgressBars[i].ForeColor := RGB(48,48,144) else if (ProgressBars[i].Progress > 40) and (ProgressBars[i].Progress <= 60) then ProgressBars[i].ForeColor := RGB(96,48,144) else if (ProgressBars[i].Progress > 60) and (ProgressBars[i].Progress <= 80) then ProgressBars[i].ForeColor := RGB(144,48,144) else if ProgressBars[i].Progress > 80 then ProgressBars[i].ForeColor := RGB(200,48,48); Shapes[i] := TShape.Create(Owner); Shapes[i].Parent := FScrollBox[This_Index]; Shapes[i].Left := Labels[i].Left - 10; Shapes[i].top := Labels[i].Top - 10; if FEditorstyle = TsMemo then begin Shapes[i].height := ProgressBars[i].height + Labels[i].height +20 +10; Shapes[i].Width := (ProgressBars[i].left - Labels[i].left) + ProgressBars[i].Width + 20; end else begin Shapes[i].height := (ProgressBars[i].Top - Labels[i].Top) + ProgressBars[i].Height + 20; Shapes[i].Width := Labels[i].Width +20; end; Shapes[i].Brush.Color := clSkyBlue; Shapes[i].Visible := True; Shapes[i].SendToBack; if not DataSource.DataSet.Eof then DataSource.DataSet.next; end; DataSource.DataSet.EnableControls; tmpado.Close; XXX.Free; if FPageControl.PageCount > 0 then begin FPageControl.ActivePageIndex := FPageControl.PageCount-1; FPageControl.ActivePageIndex := 0; end; Finally FPageControl.Visible := True; end; end; destructor TAutoPanel.Destroy; begin FreeEditors; Inherited Destroy; end; function TAutoPanel.comEditor(Index :Integer) :TComboBox; begin if Index< Length(comEditors) then Result := comEditors[Index] else Result := nil; end; function TAutoPanel.edEditor(Index :Integer) :Tedit; begin if Index < Length(edEditors) then Result := edEditors[Index] else Result := nil; end; function TAutoPanel.MemoEditor(Index :Integer) :TMemo; begin if Index< Length(MemoEditors) then Result := MemoEditors[Index] else Result := nil; end; procedure TAutoPanel.inti_Grid(sender :TObject); begin try // 创建FP_Parent FP_Parent := TPanel.Create(Owner); with FP_Parent Do begin Parent := Self; Visible := False; Font.Name := '宋体'; Font.Size := 9; Font.Style:= [fsBold]; Align := AlNone; BevelInner := bvLowered; BevelOuter := bvRaised; Width := 380; Height := 250; try Left := round(((Sender as Tlabel).Parent.Width-380)/2); Top := round(((Sender as Tlabel).Parent.height-250)/2); except Left := 0; Top := 0; end; end; FP_Move := TMovePanel.Create(Owner); with FP_Move do begin Parent := FP_Parent; ParentFont := true; BevelInner := bvLowered; BevelOuter := bvRaised; Height := 26; Align := AlTop; Color := clSkyBlue; Caption := ''; OnDblClick := FP_MovePanelDblClick; Visible := True; end; FPass_Grid := TDBGrid.Create(Owner); with FPass_Grid do begin Parent := FP_Parent; ParentFont := true; Font.Style:= []; Align := AlClient; Visible := True; DataSource := TmpDs; end; except FPass_Grid := Nil; FP_Move := Nil; FP_Parent := Nil; end; end; //响应Labels[i]的Click事件 procedure TAutoPanel.LabelsClick(Sender: TObject); var i :integer; Tmp_Area,Tmp_Berth :String; begin try if FP_Parent = nil then inti_Grid(Sender); if FP_Parent = nil then exit; Tmp_Berth := trim((Sender as Tlabel).Caption); Tmp_Area := trim(((Sender as Tlabel).Parent as TScrollBox).Hint); if tmpado.Active then begin if tmpado.FieldValues['库位'] <> null then if tmpado.FieldByName('库位').AsString = Tmp_Berth then exit; end; screen.Cursor := crSQLWait; //FP_Parent.Visible := False; //FP_Parent.Left := FPageControl.Left + (Sender as Tlabel).Left + (Sender as Tlabel).Width + 28; //FP_Parent.Top := FPageControl.Top + (Sender as Tlabel).top + (Sender as Tlabel).Height +4; FP_Move.Caption := trim((Sender as Tlabel).Hint) + '明细列表'; with tmpado do begin DisableConTrols; Active := False; ConnectionString := Fcnnstr; tmpado.CursorType := ctStatic; tmpado.LockType := ltReadOnly; CommandText := 'Exec '+Data_BerthListSql+' '''+Store_Name+''','''+Tmp_Area+''','''+Tmp_Berth+''''; Active := True; First; EnableConTrols; for i := 0 to Fields.Count -1 do begin Fields[i].Alignment := taCenter; if i = 0 then fields[i].DisplayWidth := 20 else fields[i].DisplayWidth := 8; Fpass_Grid.Columns[i].Title.Alignment := taCenter; Fpass_Grid.Columns[i].Title.Font.Style:= []; end; end; screen.Cursor := crDefault; FP_Parent.Visible := True; except screen.Cursor := crDefault; end; end; procedure TAutoPanel.FP_MovePanelDblClick(Sender: TObject); begin FP_Parent.Visible := False; end; // 内存的释放是要有顺序的！必须以创建的相反的顺序进行！尤其是当组件之间有父子关系时 procedure TAutoPanel.FreeEditors; begin if FPageControl <> nil then begin if FP_Parent <> nil then begin try FPass_Grid.Free; FP_Move.Free; FP_Parent.Free; except // end; end; FPass_Grid := nil; FP_Move := nil; FP_Parent := nil; Shapes := nil; ProgressBars := nil; comEditors := nil; edEditors := nil; MemoEditors := nil; FScrollBox := nil; tmpDs.Free; tmpado.Free; FPageControl.Free; end; end; end.