adbpanel.pas

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

  property IsDragging : Boolean read FIsDragging;
  property Repository : TAutoRepository read GetRepository write SetRepository;
  property PanelLayout : TAutoPanelLayout read FPanelLayout write SetPanelLayout;
  property Pages : TAutoPanelPages read GetPages;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  procedure ControlsCustomizing;
  procedure EndControlsCustomizing;

  property IsCustomizing : Boolean read FIsCustomizing;
  property SelectedField : TField read GetSelectedField;  
end;

TAutoDBPanel = class(TCustomAutoDBPanel)
published
  property Align;
  property Enabled;
  property PanelLayout;
  property Repository;  
  property TabStop default True;
end;

TAutoDBPanelTemplate = class(TAutoRepositoryChild)
private
  FPanelLayout : TAutoPanelLayout;

  procedure SetPanelLayout(Value : TAutoPanelLayout);
protected
  function GetDataSet : TDataSet; override;
  procedure RemoveFromRepository(Value : TAutoRepository); override;
  procedure AddToRepository(Value : TAutoRepository); override;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;

  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
published
  property PanelLayout : TAutoPanelLayout read FPanelLayout write SetPanelLayout;
end;

TAutoDBForm = class(TComponent)
private
  FPanelLayout : TAutoPanelLayout;
  FActive : Boolean;
  FForm : TForm;
  FBOk : TButton;
  FBCancel : TButton;
  FBorderIcons : TBorderIcons;
  FBorderStyle : TFormBorderStyle;
  FCaption : String;
  FColor : TColor;
  FCtl3D : Boolean;
  FCursor : TCursor;
  FFont : TFont;
  FFormStyle : TFormStyle;
  FIcon : TIcon;
  FMenu : TMainMenu;
  FActiveChanged : TNotifyEvent;

  function GetRepository : TAutoRepository;
  procedure SetActive(Value : Boolean);
  procedure SetBorderIcons(Value : TBorderIcons);
  procedure SetBorderStyle(Value : TFormBorderStyle);
  procedure SetCaption(Value : String);
  procedure SetColor(Value : TColor);
  procedure SetCtl3D(Value : Boolean);
  procedure SetCursor(Value : TCursor);
  procedure SetFont(Value : TFont);
  procedure SetFormStyle(Value : TFormStyle);
  procedure SetIcon(Value : TIcon);
  procedure SetMenu(Value : TMainMenu);
  procedure SetPanelLayout(Value : TAutoPanelLayout);
  procedure SetRepository(Value : TAutoRepository);

  procedure FontChanged(Sender : TObject);
  procedure FormClose(Sender : TObject; Var Action : TCloseAction);
  procedure FormResize(Sender : TObject);
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  procedure Show;
published
  property Active : Boolean read FActive write SetActive;
  property BorderIcons : TBorderIcons read FBorderIcons write SetBorderIcons;
  property BorderStyle : TFormBorderStyle read FBorderStyle write SetBorderStyle;
  property Caption : String read FCaption write SetCaption;
  property Color : TColor read FColor write SetColor;
  property Ctl3D : Boolean read FCtl3D write SetCtl3D;
  property Cursor : TCursor read FCursor write SetCursor;
  property Font : TFont read FFont write SetFont;
  property FormStyle : TFormStyle read FFormStyle write SetFormStyle;
  property Icon : TIcon read FIcon write SetIcon;
  property Menu : TMainMenu read FMenu write SetMenu;
  property PanelLayout : TAutoPanelLayout read FPanelLayout write SetPanelLayout;
  property Repository : TAutoRepository read GetRepository write SetRepository;
  property ActiveChanged : TNotifyEvent read FActiveChanged write FActiveChanged;  
end;

implementation
uses aclconst, adbpnped, adefctrl, extctrls, autostrs, audbstrs, TypInfo,
  Dialogs, DBTables;

Var
  ScrollBoxTimerID : Integer;
  ScrollBoxTimerUp : Boolean;

const
  MaxMapSize = (MaxInt div 2) div SizeOf(Integer);

type
  PIntArray = ^TIntArray;
  TIntArray = array[0..MaxListSize] of Integer;


procedure AssignPanelFont(ADest, ASource : TFont);
Var
  OnChangeEvent : TNotifyEvent;
begin
  OnChangeEvent := ADest.Onchange;
  try
    ADest.Onchange := Nil;
    ADest.Assign(ASource);
  finally
    ADest.Onchange := OnChangeEvent;
  end;
end;

procedure  DrawCaptionText(ACanvas : TCanvas; AFont : TFont; ARect : TRect;
      AAlignment : TAlignment; AText : String; Selected : Boolean);
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX,
      DT_RIGHT or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX,
      DT_CENTER or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX );
begin
  ACanvas.Font.Assign(AFont);
  if Selected then
    ACanvas.Font.Color := clWhite
  else ACanvas.Font.Color := AFont.Color;
  DrawText(ACanvas.Handle, PChar(AText), Length(AText), ARect, AlignFlags[AAlignment]);
end;

procedure DrawDraggingLine(ACanvas : TCanvas; ARect : TRect);
const
  dXY = 2;
var
  OldColorp, OldColorb : TColor;
begin
  with ACanvas do begin
    OldColorb := Brush.Color;
    OldColorp := Pen.Color;

    Brush.Color := clBlack;
    Pen.Color := Brush.Color;
    if((ARect.Bottom - ARect.Top) < (ARect.Right - ARect.Left)) then begin
      InflateRect(ARect, -2 * dXY, - dXY - 1);
      Polygon([Point(ARect.Left - dXY, ARect.Bottom + dXY), Point(ARect.Left - dXY, ARect.Top - dXY),
        Point(ARect.Left, ARect.Top), Point(ARect.Right, ARect.Top),
        Point(ARect.Right + dXY, ARect.Top - dXY), Point(ARect.Right + dXY, ARect.Bottom + dXY),
        Point(ARect.Right, ARect.Bottom), Point(ARect.Left, ARect.Bottom)]);
    end else begin
      InflateRect(ARect, - dXY - 1, - 2 * dXY);
      Polygon([Point(ARect.Left - dXY, ARect.Bottom + dXY), Point(ARect.Left, ARect.Bottom),
        Point(ARect.Left, ARect.Top), Point(ARect.Left - dXY, ARect.Top - dXY),
        Point(ARect.Right + dXY, ARect.Top - dXY), Point(ARect.Right, ARect.Top),
        Point(ARect.Right, ARect.Bottom), Point(ARect.Right + dXY, ARect.Bottom + dXY)]);
    end;
    Brush.Color := OldColorb;
    Pen.Color := OldColorp;
  end;
end;

{TAutoPanelControl}
constructor TAutoPanelControl.Create(Collection : TCollection);
begin
  inherited Create(Collection);
  Controls := TAutoPanelControls(Collection);
  FPanelField := Nil;
  FControl := Nil;
  FLabel := Nil;
  FCreated := False;
end;

destructor TAutoPanelControl.Destroy;
Var
  OldPanelLayout : TAutoPanelLayout;
begin
  OldPanelLayout := PanelLayout;
  if Not (csDestroying in PanelLayout.Owner.ComponentState)
  And Not (OldPanelLayout.IsDestroying) then begin
    if (PanelLayout.Owner is TCustomAutoDBPanel)
    And (PanelLayout.Panel.FDownControl = self) then
        PanelLayout.Panel.FDownControl := Nil;
    if (FControl <> Nil) And Not (csDestroying in FControl.ComponentState) then begin
      if (DBDefControl <> Nil) then
        DBDefControl.DestroyControl(FControl)
      else FControl.Free;
    end;
    if(FLabel <> Nil) And Not (csDestroying in FLabel.ComponentState) then
      FLabel.Free;
    if(FPanelField <> Nil) then
      FPanelField.FControl := Nil;
  end;
  inherited;
  if(OldPanelLayout <> Nil) And Not (OldPanelLayout.FLinkActiveChanging)
  And (OldPanelLayout.Owner <> Nil) And Not (OldPanelLayout.IsDestroying) then
    OldPanelLayout.UpdateLayout(False);
end;

procedure TAutoPanelControl.Assign(Source: TPersistent);
Var
  AControl : TAutoPanelControl;
begin
  if(Source is TAutoPanelControl) then begin
    AControl := TAutoPanelControl(Source);
    if(AControl.PanelLayout = PanelLayout) then
       FPanelField := AControl.FPanelField;
  end else inherited Assign(Source);
end;

procedure TAutoPanelControl.ReadFieldIndex(Reader: TReader);
Var
  AIndex : Integer;
begin
  AIndex := Reader.ReadInteger;
  if(AIndex > -1) And (AIndex < PanelLayout.Fields.Count) then begin
    FPanelField := PanelLayout.Fields[AIndex];
    if(FPanelField <> Nil) then
      FPanelField.FControl := self;
  end;
end;

procedure TAutoPanelControl.WriteFieldIndex(Writer: TWriter);
begin
  Writer.WriteInteger(FPanelField.Index);
end;

procedure TAutoPanelControl.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('FieldIndex', ReadFieldIndex, WriteFieldIndex, True);
end;

function TAutoPanelControl.GetAlignment : TAlignment;
begin
  if(FPanelField <> Nil) then
    Result := FPanelField.Alignment
  else Result := Controls.Page.Alignment;
end;

function TAutoPanelControl.GetCaption : String;
begin
  if(FPanelField <> Nil) then
    Result := FPanelField.Caption
  else Result := '';
end;

function TAutoPanelControl.GetField : TField;
begin
  if(FPanelField <> Nil) then
    Result := FPanelField.Field
  else Result := Nil;
end;

function TAutoPanelControl.GetFont : TFont;
begin
  if(FPanelField <> Nil) then
    Result := FPanelField.InternalFont
  else Result := PanelLayout.Font;
end;

function TAutoPanelControl.GetDBDefControl : TAutoDBDefControl;
begin
  if(FPanelField <> Nil) then
    Result := FPanelField.DBDefControl
  else  Result := Nil;
end;

function TAutoPanelControl.GetPanelLayout : TAutoPanelLayout;
begin
  Result := Controls.PanelLayout;
end;

function TAutoPanelControl.GetRect : TRect;
Var
  AWidth, AHeight : Integer;
begin
  if(FLabel = Nil) Or (FControl = Nil) then exit;

  if(Controls.Page.LabelLayout = pllLeft) then begin
    if (Controls.Page.ControlLayout = pclVert) then
      AWidth := Controls.Page.FMaxLabelWidth
    else AWidth := FLabel.Width + AutoPanelLabelDY;
    Inc(AWidth, FControl.Width);
    AHeight := FControl.Height;
  end else begin
    if(FControl.Width > FLabel.Width) then
      AWidth := FControl.Width
    else AWidth := FLabel.Width;
    AHeight := FLabel.Height + AutoPanelLabelDY + FControl.Height;
  end;
  Inc(AHeight, AutoPanelControlDY div 2);
  Inc(AWidth, AutoPanelControlDY div 2);
  SetRect(Result, FLeft - AutoPanelControlDY div 2, Top - AutoPanelControlDY div 2,
          FLeft + AWidth, Top + AHeight);
end;

function TAutoPanelControl.GetTop;
begin
  if(FLabel <> Nil) then
    Result := FLabel.Top
  else Result := 0;
end;
procedure TAutoPanelControl.SetCreated(Value : Boolean);
begin
  if(FCreated <> Value) then begin
    if(FDBDefControl <> Nil) then
      FDBDefControl.DestroyControl(FControl);
    if(FLabel <> Nil) then
      FLabel.Free;
    FCreated := Value;
    FDBDefControl := Nil;
  end;
end;

{TAutoPanelControls}
constructor TAutoPanelControls.Create(APage : TAutoPanelPage);
begin
  inherited Create(TAutoPanelControl);
  FPage := APage;
end;

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

function TAutoPanelControls.Add(APanelField : TAutoPanelField) : TAutoPanelControl;
begin
  Result := TAutoPanelControl(inherited Add);
  Result.FPanelField := APanelField;
  APanelField.FControl := Result;
  if Not (PanelLayout.FLinkActiveChanging) then
    PanelLayout.UpdateLayout(False);
end;

procedure TAutoPanelControls.Update(Item: TCollectionItem);
begin
  //TODO
end;

procedure TAutoPanelControls.Assign(Source: TPersistent);
Var
  AControls : TAutoPanelControls;
  AControl : TAutoPanelControl;
  AField : TAutoPanelField;
  i : Integer;
  OldAssignFlag : Boolean;
begin
  if(Source is TAutoPanelControls) then begin
    OldAssignFlag := PanelLayout.FAssignFlag;
    PanelLayout.FAssignFlag := True;
    AControls := Source as TAutoPanelControls;
    if(AControls.PanelLayout.FDataLink.DataSet = PanelLayout.FDataLink.DataSet) then begin
      Clear;
      for i := 0 to AControls.Count - 1 do
        if (AControls[i].FPanelField <> Nil) then begin
          AField := PanelLayout.Fields[AControls[i].FPanelField.Index];
          if(AField <> Nil) And (AField.FControl = Nil) then begin
            AControl := Add(AField);
            AField.FControl := AControl;
          end;
        end;
    end;
    PanelLayout.FAssignFlag := OldAssignFlag;
    if Not PanelLayout.FAssignFlag then
      PanelLayout.UpdateLayout(False);
  end else inherited Assign(Source);
end;

function TAutoPanelControls.GetItem(Index : Integer) : TAutoPanelControl;
begin
  Result := TAutoPanelControl(inherited Items[Index]);
end;

procedure TAutoPanelControls.SetItem(Index : Integer; Value : TAutoPanelControl);
begin
  Items[Index].Assign(Value);
end;

function TAutoPanelControls.GetPanelLayout : TAutoPanelLayout;
begin
  Result := FPage.PanelLayout;
end;

function TAutoPanelControls.GetPages : TAutoPanelPages;
begin
  Result := FPage.Pages;
end;

{TAutoPanelPage}
constructor TAutoPanelPage.Create(Collection : TCollection);
begin
  inherited Create(Collection);
  Pages := TAutoPanelPages(Collection);
  FControls := TAutoPanelControls.Create(self);
  FCaption := LoadStr(ACDB_PANELNEWPAGE);
end;

destructor TAutoPanelPage.Destroy;
begin
  FControls.Free;
  inherited Destroy;
end;

function TAutoPanelPage.GetPanelLayout : TAutoPanelLayout;
begin
  Result := Pages.PanelLayout;
end;

function TAutoPanelPage.GetAlignment : TAlignment;
begin
  if ppvAlignment in FAssignedValues then
    Result := FAlignment
  else Result := DefaultAlignment;
end;

function TAutoPanelPage.GetColor : TColor;
begin
  if ppvColor in FAssignedValues then
    Result := FColor
  else Result := DefaultColor;
end;

function TAutoPanelPage.GetControlLayout : TAutoControlLayout;
begin
  if ppvControlLayout in FAssignedValues then
    Result := FControlLayout
  else Result := DefaultControlLayout;
end;

function TAutoPanelPage.GetLabelLayout : TAutoLabelLayout;
begin