adbpanel.pas

来自「delphi编程控件」· PAS 代码 · 共 2,248 行 · 第 1/5 页

    begin
      Canvas.Brush.Color := clGray;
      Canvas.Font.Color := clHighlightText
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State) else
      Canvas.FillRect(rcItem);
    Canvas.Handle := 0;
  end;
end;

{TAutoPanelIncSearch}
function TAutoPanelIncSearch.GetDBControl : TWinControl;
begin
  if(FPanelLayout <> Nil) then
    Result := FPanelLayout.Panel
  else Result := Nil;  
end;

function TAutoPanelIncSearch.GetDataSource : TDataSource;
begin
  if(FPanelLayout <> Nil) then
    Result := FPanelLayout.DataSource
  else Result := Nil;    
end;

function TAutoPanelIncSearch.GetField : TField;
begin
  if(FPanelLayout <> Nil) And (FPanelLayout.Panel <> Nil) then
    Result := FPanelLayout.Panel.SelectedField
  else Result := Nil;    
end;

{TAutoPanelLayout}
constructor TAutoPanelLayout.Create(AOwner : TComponent);
begin
  inherited Create;

  FOwner := AOwner;
  FDataLink := TAutoDBPanelDataLink.Create(self);
  FDataSource := TDataSource.Create(Nil);  
  FControlLayout := pclVert;
  FLabelLayout := pllLeft;
  FFont := TFont.Create;
  FFont.Onchange := FontChanged;
  FRepository := Nil;
  FPages := TAutoPanelPages.Create(self);
  FFields := TAutoPanelFields.Create(self);
  FReadOnly := False;
  FOptions := [apoScrollBar];
  FUpdatedCount := 0;
  FAssignFlag := False;
  FIncSearch := TAutoPanelIncSearch.Create;
  FIncSearch.FPanelLayout := self;
  FLinkActiveChanging := False;
end;

destructor TAutoPanelLayout.Destroy;
begin
  FDataSource.DataSet := Nil;
  if(FRepository <> Nil) then begin
    FRepository.DestroyObjectLink(self);
    FRepository := Nil;
  end;
  FFields.Free;
  FPages.Free;
  FDataLink.Free;
  FFont.Free;
  FIncSearch.Free;
  FDataSource.Free;
  
  inherited Destroy;
end;

{$IFDEF DELPHI4}
function  TAutoPanelLayout.GetOwner: TPersistent;
begin
  Result := FOwner;
end;
{$ENDIF}

procedure TAutoPanelLayout.Assign(Source: TPersistent);
Var
  APanelLayout : TAutoPanelLayout;
begin
  if(Source is TAutoPanelLayout) then begin
    APanelLayout := Source as TAutoPanelLayout;
    FAssignFlag := True;
    BeginUpdateLayout;

    Fields.Assign(APanelLayout.Fields);
    DataSource := APanelLayout.DataSource;
    AssignPanelFont(FFont, APanelLayout.Font);
    FControlLayout := APanelLayout.ControlLayout;
    FLabelLayout := APanelLayout.LabelLayout;
    FOptions := APanelLayout.Options;
    Pages.Assign(APanelLayout.Pages);
    FReadOnly := APanelLayout.ReadOnly;
    FIncSearch.Assign(APanelLayout.IncSearch);

    FAssignFlag := False;
    EndUpdateLayout;
  end else inherited Assign(Source);
end;

procedure TAutoPanelLayout.ReadCustomized(Reader: TReader);
Var
  Cust : Boolean;
begin
  Cust := Reader.ReadBoolean;
  if(Fields.Count > 0) then
    Fields[0].FCustomized := Cust;
end;

procedure TAutoPanelLayout.WriteCustomized(Writer: TWriter);
begin
  Writer.WriteBoolean(Fields.Customized);
end;

procedure TAutoPanelLayout.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('Customized', ReadCustomized, WriteCustomized, True);
end;

procedure TAutoPanelLayout.BeginUpdateLayout;
begin
  if(CanUpdateLayout) then
    Inc(FUpdatedCount);
end;

procedure TAutoPanelLayout.EndUpdateLayout;
begin
  if(CanUpdateLayout) then begin
    if(FUpdatedCount > 0) then
      Dec(FUpdatedCount);
    if(FUpdatedCount = 0) then
      Panel.UpdateLayout;
  end;
end;

procedure TAutoPanelLayout.UpdateLayout(Immediate : Boolean);
begin
  if(Immediate) then
    FUpdatedCount := 1;
  EndUpdateLayout;
end;


procedure TAutoPanelLayout.UpdateControlLayout;
begin
  if(CanUpdateLayout) then begin
    if(FUpdatedCount = 0) then
      Panel.UpdateScrollBoxesLayout;
  end;
end;

function TAutoPanelLayout.CanUpdateLayout : Boolean;
begin
  Result := (Panel <> Nil) And Not (csLoading in Panel.ComponentState)
    And Not (csDestroying in Panel.ComponentState)
    And Not (csCreating in Panel.ControlState) And Panel.HandleAllocated
    And Not FAssignFlag And Not Panel.FDestroying;
end;

procedure TAutoPanelLayout.UpdateCustomizingFields;
begin
  if(ACustomizingListBox <> Nil) then
   ACustomizingListBox.UpdateItems;
end;

function TAutoPanelLayout.GetDataSet : TDataSet;
begin
  Result := FDataLink.DataSet;
end;

function TAutoPanelLayout.GetDataSource : TDataSource;
begin
  Result := FDataLink.DataSource
end;

function TAutoPanelLayout.GetPanel : TCustomAutoDBPanel;
begin
  if(Owner <> Nil) And (Owner is TCustomAutoDBPanel) then
    Result := Owner as TCustomAutoDBPanel
  else Result := Nil;
end;

procedure TAutoPanelLayout.SetDataSource(Value : TDataSource);
begin
  FDataLink.DataSource := Value;
end;

procedure TAutoPanelLayout.SetRepository(Value : TAutoRepository);
begin
  if(FRepository <> Value) then begin
    DestroyControls;

    if(FRepository <> Nil) then
      FRepository.DestroyObjectLink(self);
    FRepository := Value;
    if(FRepository <> Nil) then
      FRepository.AddObjectLink(self);

    if CanUpdateLayout then
      UpdateLayout(False);
  end;
end;

procedure TAutoPanelLayout.SetFont(Value : TFont);
begin
  FFont.Assign(Value);
end;

procedure TAutoPanelLayout.SetFields(Value : TAutoPanelFields);
begin
  FFields.Assign(Value);
end;

procedure TAutoPanelLayout.SetControlLayout(Value : TAutoControlLayout);
begin
  if(FControlLayout <> Value) then begin
    FControlLayout := Value;
    UpdateControlLayout;
  end;
end;

procedure TAutoPanelLayout.SetIncSearch(Value : TAutoPanelIncSearch);
begin
  FIncSearch.Assign(Value);
end;

procedure TAutoPanelLayout.SetLabelLayout(Value : TAutoLabelLayout);
begin
  if(FLabelLayout <> Value) then begin
    FLabelLayout := Value;
    UpdateControlLayout;
  end;
end;

procedure TAutoPanelLayout.SetPages(Value : TAutoPanelPages);
begin
  FPages.Assign(Value);
end;

procedure TAutoPanelLayout.SetOptions(Value : TAutoPanelOptions);
begin
  if(FOptions <> Value) then begin
    FOptions := Value;
    if(Panel <> Nil) then
      Panel.RecreateWnd;
//    UpdateLayout(False);
  end;
end;

procedure TAutoPanelLayout.DestroyControls;
Var
  i, j : Integer;
  OldFLinkActiveChanging : Boolean;
begin
  if CanUpdateLayout then begin
    OldFLinkActiveChanging := FLinkActiveChanging;
    FLinkActiveChanging := True;
     for i := 0 to Pages.Count - 1 do
       for j := 0 to Pages[i].Controls.Count - 1 do
         Pages[i].Controls[j].Created := False;
    FLinkActiveChanging := OldFLinkActiveChanging;
  end;
end;

function TAutoPanelLayout.IsDestroying : Boolean;
begin
  Result := (Owner is TCustomAutoDBPanel) and TCustomAutoDBPanel(Owner).FDestroying;
end;

procedure TAutoPanelLayout.LinkActive(Active : Boolean);
Var
  i : Integer;
begin
   FLinkActiveChanging := True;
   FDataSource.DataSet := FDataLink.DataSet;
   if (Owner <> Nil) and Not (csLoading in Owner.ComponentState)
   and Not FAssignFlag then begin
     FFields.RebuildFields;
     if FFields.Customized then begin
       if(Active) then
         DestroyControls;
       for i := 0 to FFields.Count - 1 do
        if Active Or (Not FDataLink.DefaultFields)then
           FFields[i].FField := FFields[i].Field
        else FFields[i].FField := Nil;
       UpdateLayout(True);
     end;
   end;  
   if(Panel <> Nil) then
     Panel.UpdateVertScrollBar;
   FLinkActiveChanging := False;
end;

procedure TAutoPanelLayout.Scroll(Distance : Integer);
begin
  if(Panel <> Nil) then
    Panel.UpdateVertScrollBar;
end;

procedure TAutoPanelLayout.DataChanged;
begin
  if(Panel <> Nil) then
    Panel.UpdateVertScrollBar;
end;

procedure TAutoPanelLayout.RecordChanged(Field: TField);
begin
end;

procedure TAutoPanelLayout.FieldNotification(AField : TField);
Var
  i : Integer;
begin
  if(AField <> Nil) And (Owner <> Nil)
  And Not (csDestroying in Owner.ComponentState)
  And Not (csLoading in Owner.ComponentState) then begin
    i := 0;
    while i < Fields.Count do begin
      if(Fields[i].Field = AField) Or (Fields[i].Field = Nil) then
        Fields[i].Free
      else Inc(i);
    end;
  end;
end;

procedure TAutoPanelLayout.FontChanged(Sender : TObject);
begin
  UpdateLayout(False);
end;

{TDBControlPage}
type
TDBPageControl = class(TPageControl)
private
  FPanel : TCustomAutoDBPanel;
  procedure WMPaint(Var Message : TWMPaint); message WM_PAINT;
end;

procedure TDBPageControl.WMPaint(Var Message : TWMPaint);
begin
  if(FPanel <> Nil) And (FPanel.IsDragging)
  And (ScrollBoxTimerId = -1) then
    FPanel.FDragImage.HideDragImage;
  inherited;
  if(FPanel <> Nil) And (FPanel.IsDragging)
  And (ScrollBoxTimerId = -1) then
    FPanel.FDragImage.ShowDragImage;
end;

{TDBScrollBox}
type
TDBScrollBox = class(TScrollBox)
private
  FPanel : TCustomAutoDBPanel;
  FCanvas : TCanvas;
  FPointDragging : TPoint;
  FDragFlag : Boolean;

  procedure WMKeyDown(Var Message : TMessage); message WM_KEYDOWN;
  procedure WMPaint(Var Message : TWMPaint); message WM_PAINT;  
protected
  procedure PaintWindow(DC: HDC); override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;  
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
end;

constructor TDBScrollBox.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  FDragFlag := False;
end;

destructor TDBScrollBox.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

procedure TDBScrollBox.WMKeyDown(Var Message : TMessage);
begin
  if(FPanel <> Nil) then
    SendMessage(FPanel.Handle, WM_KEYDOWN, Message.wParam, Message.lParam);
end;

procedure TDBScrollBox.WMPaint(Var Message : TWMPaint);
begin
  if(FPanel <> Nil) And (FPanel.IsDragging)
  And (ScrollBoxTimerId = -1) then
    FPanel.FDragImage.HideDragImage;
  inherited;
  if(FPanel <> Nil) And (FPanel.IsDragging)
  And (ScrollBoxTimerId = -1) then
    FPanel.FDragImage.ShowDragImage;
end;

procedure TDBScrollBox.PaintWindow(DC: HDC);
Var
  r : TRect;
begin
  if(FPanel <> Nil) And (FPanel.IsCustomizing) then begin
    try
      FCanvas.Handle := DC;
      if(FPanel.FDownControl <> Nil)
      And (FPanel.FDownControl.Controls.Page = FPanel.ActivePage) then begin
        r := FPanel.FDownControl.Rect;
        InflateRect(r, 1, 1);
        FCanvas.Brush.Color := clGray;
        FCanvas.FillRect(r);
        DrawEdge(FCanvas.Handle, r, EDGE_BUMP, BF_RECT);
      end;
      if(FPanel.IsDragging) And (FPanel.FAccept) then
        DrawDraggingLine(FCanvas, FPanel.FDragRect);
    finally
      FCanvas.Handle := 0;
    end;
  end;    
end;

procedure TDBScrollBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer);
Var
  ADownControl : TAutoPanelControl;
  i : Integer;
  AControls : TAutoPanelControls;
  r : TRect;
begin
  if(FPanel <> Nil) And (FPanel.IsCustomizing) And (Button = mbLeft) then begin
    ADownControl := Nil;
    for i := 0 to FPanel.FScrollBoxes.Count - 1 do
      if(self = TDBScrollBox(FPanel.FScrollBoxes[i])) then break;
    AControls := FPanel.Pages[i].Controls;
    for i := 0 to AControls.Count - 1 do begin
      r := AControls[i].Rect;
      if(X > r.Left) And (X < r.Right) And (Y > r.Top) And (Y < r.Bottom) then begin
        ADownControl := AControls[i];