adbpanel.pas

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

begin
  inherited Create(TAutoPanelField);
  FPanelLayout := APanelLayout;
end;

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

function TAutoPanelFields.Add : TAutoPanelField;
begin
  Result := TAutoPanelField(inherited Add);
end;

procedure TAutoPanelFields.Assign(Source: TPersistent);
Var
  AFields : TAutoPanelFields;
  AField : TAutoPanelField;
  i : Integer;
  OldAssignFlag : Boolean;
begin
  if(Source is TAutoPanelFields) then begin
    OldAssignFlag := PanelLayout.FAssignFlag;
    PanelLayout.FAssignFlag := True;
    AFields := Source as TAutoPanelFields;
    Clear;
    PanelLayout.Pages.Clear;
    for i := 0 to AFields.Count - 1 do begin
      AField := Add;
      AField.Assign(AFields[i]);
    end;
    Customized := AFields.Customized;
    PanelLayout.UpdateCustomizingFields;
    PanelLayout.FAssignFlag := OldAssignFlag;
    if Not PanelLayout.FAssignFlag then
      PanelLayout.UpdateLayout(False);
  end else inherited Assign(Source);
end;

function TAutoPanelFields.GetField(Index : Integer): TAutoPanelField;
begin
  Result := TAutoPanelField(inherited Items[Index]);
end;

function TAutoPanelFields.GetCustomized : Boolean;
begin
  Result := (Count > 0) And Items[0].FCustomized;
end;

procedure TAutoPanelFields.SetField(Index : Integer; Value : TAutoPanelField);
begin
  Items[Index].Assign(Value);
end;

procedure TAutoPanelFields.SetCustomized(Value : Boolean);
begin
  if Value <> Customized then begin
    if Value then
      Clear
    else RebuildFields;
  end;
end;

procedure TAutoPanelFields.RestoreDefaults;
Var
  i : Integer;
begin
  BeginUpdate;
  try
    for i := 0 to Count - 1 do
      Items[i].RestoreDefaults;
  finally
    EndUpdate;
  end;
end;

procedure TAutoPanelFields.Update(Item : TCollectionItem);
begin
  if Not (csLoading in FPanelLayout.FOwner.ComponentState)
  And Not (FPanelLayout.FLinkActiveChanging) then
    FPanelLayout.UpdateLayout(False);
end;

function TAutoPanelFields.FieldByFieldName(AFieldName : String) : TAutoPanelField;
Var
  i : Integer;
begin
  Result := Nil;
  for i := 0 to Count - 1 do
    if(CompareText(Items[i].FieldName, AFieldName) = 0) then
    begin
      Result := Items[i];
      exit;
    end;
end;

procedure TAutoPanelFields.RebuildFields;
var
  i : Integer;
  AField : TAutoPanelField;
  ADSField : TField;
  APage : TAutoPanelPage;
begin
  if Customized  then begin
    if Not (FPanelLayout.FDataLink.Active) then
      for i := 0 to Count - 1 do
        Items[i].FField := Nil;
  end
  else begin
    try
      FPanelLayout.BeginUpdateLayout;
      if Assigned(FPanelLayout.FDataLink.Dataset) then begin
        i := 0;
        while i < Count do begin
          ADSField := FPanelLayout.FDataLink.Dataset.FindField(Items[i].FieldName);
          if(ADSField <> nil) and (Items[i].DBDefControl =
          adefctrl.GetDBDefControl(PanelLayout.Repository, ADSField)) then 
            Inc(i)
          else Items[i].Free;  
        end;
        if(PanelLayout.Pages.Count = 0) then
          APage := PanelLayout.Pages.Add
        else APage := PanelLayout.Pages[0];
        if FPanelLayout.FDataLink.Active Or
        Not FPanelLayout.FDataLink.DefaultFields then begin
          with FPanelLayout.FDataLink.Dataset do
            for i := 0 to FieldCount - 1 do begin
              AField := FieldByFieldName(Fields[i].FieldName);
              if(AField = Nil) then begin
                AField := Add;
                AField.FCustomized := False;
                AField.FieldName := Fields[i].FieldName;
                APage.Controls.Add(AField);
              end else AField.Field := Fields[i];
            end;  
        end;
      end else Clear;
    finally
      FPanelLayout.EndUpdateLayout;
    end;
  end;  
end;

{TAutoDBPanelDataLink}
constructor TAutoDBPanelDataLink.Create(APanelLayout : TAutoPanelLayout);
begin
  inherited Create;
  FPanelLayout := APanelLayout;
end;

destructor TAutoDBPanelDataLink.Destroy;
begin
  ClearMapping;
  inherited Destroy;
end;

function TAutoDBPanelDataLink.GetDefaultFields: Boolean;
var
  I: Integer;
begin
  Result := True;
  if DataSet <> nil then Result := DataSet.DefaultFields;
  if Result and SparseMap then
  for I := 0 to FFieldCount-1 do
    if PIntArray(FFieldMap)^[I] < 0 then
    begin
      Result := False;
      Exit;
    end;
end;

function TAutoDBPanelDataLink.GetFields(I: Integer): TField;
begin
  if (0 <= I) and (I < FFieldCount) and (PIntArray(FFieldMap)^[I] >= 0) then
    Result := DataSet.Fields[PIntArray(FFieldMap)^[I]]
  else
    Result := nil;
end;

function TAutoDBPanelDataLink.AddMapping(const FieldName: string): Boolean;
var
  Field: TField;
  NewSize: Integer;
begin
  Result := True;
  if SparseMap then
    Field := DataSet.FindField(FieldName)
  else
    Field := DataSet.FieldByName(FieldName);

  if FFieldCount = FFieldMapSize then
  begin
    NewSize := FFieldMapSize;
    if NewSize = 0 then
      NewSize := 8
    else
      Inc(NewSize, NewSize);
    if (NewSize < FFieldCount) then
      NewSize := FFieldCount + 1;
    if (NewSize > MaxMapSize) then
      NewSize := MaxMapSize;
    ReallocMem(FFieldMap, NewSize * SizeOf(Integer));
    FFieldMapSize := NewSize;
  end;
  if Assigned(Field) then
  begin
    PIntArray(FFieldMap)^[FFieldCount] := Field.Index;
    Field.FreeNotification(FPanelLayout.Owner);
  end
  else
    PIntArray(FFieldMap)^[FFieldCount] := -1;
  Inc(FFieldCount);
end;

procedure TAutoDBPanelDataLink.ActiveChanged;
begin
  FPanelLayout.LinkActive(Active);
end;

procedure TAutoDBPanelDataLink.ClearMapping;
begin
  if FFieldMap <> nil then
  begin
    FreeMem(FFieldMap, FFieldMapSize * SizeOf(Integer));
    FFieldMap := nil;
    FFieldMapSize := 0;
    FFieldCount := 0;
  end;
end;

procedure TAutoDBPanelDataLink.Modified;
begin
  FModified := True;
end;

procedure TAutoDBPanelDataLink.DataSetChanged;
begin
  FPanelLayout.DataChanged;
  FModified := False;
end;

procedure TAutoDBPanelDataLink.DataSetScrolled(Distance: Integer);
begin
  FPanelLayout.Scroll(Distance);
end;


procedure TAutoDBPanelDataLink.EditingChanged;
begin
end;

procedure TAutoDBPanelDataLink.RecordChanged(Field: TField);
begin
  FPanelLayout.RecordChanged(Field);
  FModified := False;
end;

procedure TAutoDBPanelDataLink.UpdateData;
begin
  FModified := False;
end;

function TAutoDBPanelDataLink.GetMappedIndex(ColIndex: Integer): Integer;
begin
  if (0 <= ColIndex) and (ColIndex < FFieldCount) then
    Result := PIntArray(FFieldMap)^[ColIndex]
  else
    Result := -1;
end;

procedure TAutoDBPanelDataLink.Reset;
begin
  if FModified then RecordChanged(nil) else Dataset.Cancel;
end;

{TPanelFieldListBox}
type
TPanelFieldsListBox = class(TListBox)
private
  FPanelLayout : TAutoPanelLayout;
  FPointDragging : TPoint;
  FDragFlag : Boolean;

  function GetPanel : TCustomAutoDBPanel;
  procedure SetPanelLayout(Value : TAutoPanelLayout);
  procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  procedure WMMouseMove(var Message : TMessage); message WM_MOUSEMOVE;

  procedure DrawItem_(ACanvas : TCanvas; Index: Integer; Rect: TRect;
      Selected : Boolean);
  procedure UpdateItems;
protected
  procedure DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); 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;
  property PanelLayout : TAutoPanelLayout read FPanelLayout write SetPanelLayout;
  property Panel : TCustomAutoDBPanel read GetPanel;
end;

Var
  ACustomizingForm : TForm;
  ACustomizingListBox : TPanelFieldsListBox;

constructor TPanelFieldsListBox.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Style :=  lbOwnerDrawFixed;
  FDragFlag := False;
end;

procedure TPanelFieldsListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
  if(ItemIndex > -1) And (Button = mbLeft) And (Panel <> Nil) then begin
    FPointDragging.X := X;
    FPointDragging.Y := Y;
    Panel.FDragPanelField := TAutoPanelField(Items.Objects[ItemIndex]);
    FDragFlag := True;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TPanelFieldsListBox.MouseMove(Shift: TShiftState; X, Y: Integer);
Var
  bmp : TBitmap;
  ARect : TRect;
begin
  if(FDragFlag) then
    if((X < FPointDragging.X - 5) Or (X > FPointDragging.X + 5)
    Or (Y < FPointDragging.Y - 5) Or (Y > FPointDragging.Y + 5)) then begin
      Panel.DownControl := Nil;
      bmp := TBitmap.Create;
      SetRect(ARect, 0, 0, ClientWidth, ItemHeight);
      bmp.Width := ARect.Right;
      bmp.Height := ARect.Bottom;
      DrawItem_(bmp.Canvas, ItemIndex, ARect, False);
      Panel.FDragImage.Height := bmp.Height;
      Panel.FDragImage.Width :=  bmp.Width;
      Panel.FDragImage.Add(bmp, NIl);
      bmp.Free;
      Panel.FDragImage.SetDragImage(0, (Panel.FDragImage.Width - 32) div 2,
         Panel.FDragImage.Height div 2);
      Panel.StartDrag;
      FDragFlag := False;
    end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TPanelFieldsListBox.MouseUp(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer);
begin
  if(Panel <> Nil) And (Panel.IsDragging) then
    Panel.EndDrag(True);
  FDragFlag := False;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TPanelFieldsListBox.WMMouseMove(var Message : TMessage);
begin
 if(Panel = Nil) Or ( Not Panel.IsDragging) then
    inherited
  else Panel.DoControlDragging;
end;

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

procedure TPanelFieldsListBox.SetPanelLayout(Value : TAutoPanelLayout);
begin
  if(FPanelLayout <> Value) then begin
    Color := clBtnFace;
    FPanelLayout := Value;
    //TODO calculate font height
    ItemHeight := 18;
    UpdateItems;
  end;
end;

procedure TPanelFieldsListBox.UpdateItems;
Var
  i : Integer;
  AField : TAutoPanelField;
begin
  if(ItemIndex > -1) and (ItemIndex < Items.Count) then
    AField := TAutoPanelField(Items.Objects[ItemIndex])
  else AField := Nil;
  Items.Clear;
  if(FPanelLayout <> Nil) then begin
    for i := 0 to FPanelLayout.Fields.Count - 1 do
      if(FPanelLayout.Fields[i].FControl = Nil) then
        Items.AddObject(FPanelLayout.Fields[i].Caption, FPanelLayout.Fields[i]);
  end;
  if(AField <> Nil) then
    for i := 0 to Items.Count - 1 do
      if(TAutoPanelField(Items.Objects[i]) = AField) then
        ItemIndex := i
  else if(Items.Count > 0) then
     ItemIndex := 0;  
end;

procedure TPanelFieldsListBox.DrawItem_(ACanvas : TCanvas; Index: Integer; Rect: TRect;
      Selected : Boolean);
begin
  if Index < Items.Count then begin
    if (Selected) then
      ACanvas.Brush.Color := clGray
    else ACanvas.Brush.Color := Color;
    ACanvas.FillRect(Rect);

    if Not Selected then begin
      DrawEdge(ACanvas.Handle, Rect, BDR_RAISEDINNER, BF_TOPLEFT);
      DrawEdge(ACanvas.Handle, Rect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
    end else DrawEdge(ACanvas.Handle, Rect, EDGE_BUMP, BF_RECT);

    InflateRect(Rect, -2, 0);
    DrawCaptionText(ACanvas, FPanelLayout.Font, Rect, taLeftJustify,
      Items[Index], Selected);
  end;
end;

procedure TPanelFieldsListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  DrawItem_(Canvas, Index, Rect, odSelected in State);
end;

procedure TPanelFieldsListBox.CNDrawItem(var Message: TWMDrawItem);
var
  State: TOwnerDrawState;
begin
  with Message.DrawItemStruct^ do
  begin
    State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
    Canvas.Handle := hDC;
    Canvas.Font := Font;
    Canvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then