fmain.pas

来自「FlexGraphics是一套创建矢量图形的VCL组件」· PAS 代码 · 共 496 行

unit fMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables, StdCtrls, Mask, DBCtrls,
  FlexBase, FlexControls, FlexUtils, FlexProps, ExtCtrls;

type
  TControlType = ( ctUnknown, ctCopyright, ctNavButton, ctBrowseButton );

  TfmMain = class(TForm)
    fpView: TFlexPanel;
    od_Table: TOpenDialog;
    tblView: TTable;
    tmResize: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure fpViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure fpViewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure fpViewResize(Sender: TObject);
    procedure tmResizeTimer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    FCreated: boolean;
    FCopyright: TFlexControl;
    FBrowseBtn: TFlexControl;
    FNamePath: TFlexText;
    FFirstBtn: TFlexControl;
    FLastBtn: TFlexControl;
    FPrevBtn: TFlexControl;
    FNextBtn: TFlexControl;
    FHeader: TFlexControl;
    FTitleControl: TFlexText;
    FFieldControl: TFlexText;
    FTitles: TList;
    FFields: TList;
    FMinDocHeight: integer;
    FMinHeadWidth: integer;
    FCopyrightBottom: integer;
    FActiveControl: TFlexControl;
    procedure BestFit;
    procedure CheckStates;
    function  CreateControlFrom(Control: TFlexControl): TFlexControl;
    procedure HideTable;
    procedure ShowTable;
    procedure RebuildTable;
    procedure UpdateTableData;
    procedure SetRecNo(RecNo: integer);
    procedure CheckActive;
    procedure SetControlState(Control: TFlexControl; IsActive: boolean);
    procedure WMExitSizeMove(var Message: TMessage); message WM_EXITSIZEMOVE;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  fmMain: TfmMain;

implementation

{$R *.DFM}

uses
  fAboutPrg;

const
  SSelectMsg = ' Select database table file';

procedure TfmMain.FormCreate(Sender: TObject);
begin
 // Load flex document
 fpView.LoadFromFile('DbTable.fxd');
 //FMinDocHeight := fpView.DocHeight;
 FMinDocHeight := ScalePixels(300);
 // Find copyright
 FCopyright := fpView.FindControl('Copyright');
 if Assigned(FCopyright) then
  FCopyrightBottom := fpView.DocHeight - FCopyright.Top;
 // Find browse controls
 FBrowseBtn := fpView.FindControl('Browse');
 FNamePath := TFlexText(fpView.FindControl('NamePath'));
 if Assigned(FNamePath) then FNamePath.TextProp.Text := SSelectMsg;
 // Find navigator buttons
 FFirstBtn := fpView.FindControl('First');
 FLastBtn := fpView.FindControl('Last');
 FPrevBtn := fpView.FindControl('Prev');
 FNextBtn := fpView.FindControl('Next');
 // Find table items and remove it from scheme
 FTitleControl := TFlexText(fpView.FindControl('Title'));
 if Assigned(FTitleControl) then FTitleControl.Parent := Nil;
 FFieldControl := TFlexText(fpView.FindControl('Field'));
 if Assigned(FFieldControl) then FFieldControl.Parent := Nil;
 // Find header
 FHeader := fpView.FindControl('Header');
 if Assigned(FHeader) then FMinHeadWidth := FHeader.Width;
 // Adjust window size
 fpView.AutoSize;
 ClientHeight := ScaleValue(fpView.DocHeight, 100) +4;
 ClientWidth := ScaleValue(fpView.DocWidth, 100) +4;
 fpView.Align := alClient;
 BestFit;
 // Create lists
 FTitles := TList.Create;
 FFields := TList.Create;
 // Set states
 CheckStates;
 // All done
 FCreated := true;
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
 FTitles.Free;
 FFields.Free;
 // Free table items (because there is no parent)
 FTitleControl.Free;
 FFieldControl.Free;
end;

procedure TfmMain.fpViewMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if Button <> mbLeft then exit;
 if fpView.MouseControl = FCopyright then
  // About form
  ShowAbout
 else
 if (fpView.MouseControl = FBrowseBtn) or
    (fpView.MouseControl = FNamePath) then begin
  // Open table
  if not od_Table.Execute then exit;
  try
   HideTable;
   tblView.TableName := od_Table.FileName;
   ShowTable;
  finally
   CheckStates;
  end;
 end else
 if tblView.Active then begin
  // Set new position
  if fpView.MouseControl = FFirstBtn then tblView.First else
  if fpView.MouseControl = FPrevBtn  then tblView.Prior else
  if fpView.MouseControl = FNextBtn  then tblView.Next  else
  if fpView.MouseControl = FLastBtn  then tblView.Last;
  // Check buttons state
  CheckStates;
  // Update fields
  UpdateTableData;
 end;
end;

procedure TfmMain.CheckStates;

 procedure SetEnabled(Control: TFlexControl; IsEnabled: boolean);
 begin
  Control.Tag := byte(not IsEnabled);
  SetControlState(Control, Control = FActiveControl);
 end;

begin
 if tblView.Active then begin
  SetEnabled(FFirstBtn, not tblView.BoF);
  SetEnabled(FPrevBtn, not tblView.BoF);
  SetEnabled(FNextBtn, not tblView.EoF);
  SetEnabled(FLastBtn, not tblView.EoF);
 end else begin
  SetEnabled(FFirstBtn, false);
  SetEnabled(FPrevBtn, false);
  SetEnabled(FNextBtn, false);
  SetEnabled(FLastBtn, false);
 end;
end;

procedure TfmMain.fpViewMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 CheckActive;
end;

procedure TfmMain.SetControlState(Control: TFlexControl; IsActive: boolean);
var CType: TControlType;
    PassRec: TPassControlRec;
    Brush: TBrushProp;
    Pen: TPenProp;
    IsEnabled: boolean;
begin
 // Define control type
 if (Control = FBrowseBtn) or (Control = FNamePath) then
  CType := ctBrowseButton
 else
 if (Control = FFirstBtn) or (Control = FLastBtn) or
    (Control = FPrevBtn) or (Control = FNextBtn) then
  CType := ctNavButton
 else
 if (Control = FCopyright) then
  CType := ctCopyright
 else
  exit; //CType := ctUnknown;
 // Set active state
 case CType of
  ctCopyright:
    if Control is TFlexText then
    with TFlexText(Control).FontProp do
     if IsActive then begin
      Color := clRed;
      Style := Style + [ fsUnderline ];
     end else begin
      Color := clBlack;
      Style := Style - [ fsUnderline ];
     end;
  ctNavButton:
    begin
     IsEnabled := Control.Tag = 0;
     Control := fpView.FindControl('Icon', Control);
     FirstControl(Control, PassRec);
     while Assigned(Control) do begin
      // Set Brush color
      Brush := TBrushProp(Control.Props['Brush']);
      if Assigned(Brush) then
       if not IsEnabled then
        Brush.Color := clSilver
       else
       if IsActive then
        Brush.Color := clYellow
       else
        Brush.Color := clWhite;
      // Set Pen color
      Pen := TPenProp(Control.Props['Pen']);
      if Assigned(Pen) then
       if IsEnabled then
        Pen.Style := psClear
       else begin
        Pen.Style := psSolid;
        Pen.Color := clGray;
       end;
      // Next control
      Control := NextControl(PassRec);
     end;
     ClosePassRec(PassRec);
    end;
  ctBrowseButton:
    if Control is TFlexText then
    with TFlexText(Control).FontProp do
     if IsActive
      then Color := clYellow
      else Color := clWhite; 
 end;
end;

procedure TfmMain.CheckActive;
begin
 // Check change active control
 if fpView.MouseControl = FActiveControl then exit;
 // Change active
 SetControlState(FActiveControl, False);
 FActiveControl := fpView.MouseControl;
 SetControlState(FActiveControl, True);
end;

function TfmMain.CreateControlFrom(Control: TFlexControl): TFlexControl;
var MS: TMemoryStream;
    Filer: TFlexFiler;
begin
 MS := Nil;
 Filer := Nil;
 try
  MS := TMemoryStream.Create;
  Filer := TFlexFiler.Create(MS);
  Control.SaveToFiler(Filer, '');
  Filer.Rewind;
  Result := fpView.LoadFlexControl(Filer, fpView.ActiveScheme, Filer.LoadStr);
  if Assigned(Result) then Result.Layer := fpView.ActiveLayer;
 finally
  MS.Free;
  Filer.Free;
 end;
end;

procedure TfmMain.HideTable;
var i: integer;
begin
 tblView.Active := False;
 for i:=0 to FTitles.Count-1 do TFlexControl(FTitles[i]).Free;
 FTitles.Clear;
 for i:=0 to FFields.Count-1 do TFlexControl(FFields[i]).Free;
 FFields.Clear;
end;

procedure TfmMain.ShowTable;
const
  ColSpace = 2;
  RowSpace = 2;
var
  FlexText: TFlexText;
  PosX, PosY, MaxPosY: integer;
  i, RecNo, Width: integer;
  CharWidth: integer;
  CharBmp: TBitmap;
begin
 Screen.Cursor := crHourGlass;
 try
  try
   tblView.Active := True;
  except
   if Assigned(FNamePath) then FNamePath.TextProp.Text := SSelectMsg;
   raise;
  end;
  if Assigned(FNamePath) then FNamePath.TextProp.Text := ' '+tblView.TableName;
  // Build columns
  CharWidth := -1;
  PosX := FTitleControl.Left;
  for i:=0 to tblView.Fields.Count-1 do begin
   FlexText := TFlexText(CreateControlFrom(FTitleControl));
   if not Assigned(FlexText) then exit;
   if CharWidth < 0 then begin
    // Calculate character width in title
    CharBmp := TBitmap.Create;
    try
     FlexText.TextProp.Setup(CharBmp.Canvas);
     CharWidth := CharBmp.Canvas.TextWidth('W');
    finally
     CharBmp.Free;
    end;
   end;
   FlexText.TextProp.Text := '  '+tblView.Fields[i].DisplayName;
   if tblView.Fields[i].DataType = ftString then
    // Calc new field width
    FlexText.Width := ScalePixels(CharWidth * (tblView.Fields[i].Size + 2));
   FlexText.Left := PosX;
   inc(PosX, FlexText.Width + ScalePixels(ColSpace));
   FTitles.Add(FlexText);
  end;
  Width := PosX - ScalePixels(ColSpace) - FTitleControl.Left;
  // Align columns
  if Width < FMinHeadWidth then begin
   PosX := FHeader.Left + (FMinHeadWidth - Width) div 2;
   for i:=0 to FTitles.Count-1 do
    with TFlexControl(FTitles[i]) do begin
     Left := PosX;
     inc(PosX, Width + ScalePixels(ColSpace));
    end;
  end;
  // Build fields
  RecNo := tblView.RecNo;
  PosY := FFieldControl.Top;
  MaxPosY := FCopyright.Top - FCopyright.Height div 2; { +space }
  if not tblView.IsEmpty then
  while (PosY + FFieldControl.Height < MaxPosY) do begin
   for i:=0 to tblView.Fields.Count-1 do begin
    FlexText := TFlexText(CreateControlFrom(FFieldControl));
    if not Assigned(FlexText) then exit;
    FlexText.TextProp.Text := '';
    FlexText.Top := PosY;
    FlexText.Left := TFlexText(FTitles[i]).Left;
    FlexText.Width := TFlexText(FTitles[i]).Width;
    FFields.Add(FlexText);
   end;
   tblView.Next;
   if tblView.Eof then break;
   inc(PosY, FFieldControl.Height + ScalePixels(RowSpace));
  end;
  SetRecNo(RecNo);
  // Resize
  if Assigned(FHeader) then begin
   if Width < FMinHeadWidth then Width := FMinHeadWidth;
   FHeader.Width := Width;
  end;
  fpView.DocWidth := 2*FTitleControl.Left + Width;
  if Assigned(FCopyright) then
   FCopyright.Left := (fpView.DocWidth - FCopyright.Width) div 2;
  // Update fields
  UpdateTableData;
 finally
  Screen.Cursor := crDefault;
 end;
end;

procedure TfmMain.BestFit;
var NewHeight: integer;
begin
 NewHeight := ScalePixels(fpView.ClientHeight -10);
 if NewHeight < FMinDocHeight then NewHeight := FMinDocHeight;
 fpView.DocHeight := NewHeight;
 if Assigned(FCopyright) then
  FCopyright.Top := NewHeight - FCopyrightBottom;
end;

procedure TfmMain.RebuildTable;
var RecNo: integer;
begin
 tmResize.Enabled := false;
 if tblView.Active then begin
  RecNo := tblView.RecNo;
  HideTable;
  ShowTable;
  SetRecNo(RecNo);
  UpdateTableData;
  CheckStates;
 end;
end;

procedure TfmMain.UpdateTableData;
var i, Col, RecNo: integer;
    FlexText: TFlexText;
    IsEoF: boolean;
begin
 if not tblView.Active then exit;
 RecNo := tblView.RecNo;
 Col := 0;
 IsEoF := tblView.IsEmpty;
 for i:=0 to FFields.Count-1 do begin
  // Update field text
  FlexText := TFlexText(FFields[i]);
  if IsEof then
   FlexText.TextProp.Text := ''
  else
  try
   FlexText.TextProp.Text := '  '+tblView.Fields[Col].AsString;
  except
   FlexText.TextProp.Text := '  <field>';
  end;
  // Next column in row
  inc(Col);
  if Col = tblView.Fields.Count then begin
   // Next row/record
   tblView.Next;
   IsEoF := tblView.EoF;
   Col := 0;
  end;
 end;
 // Restore table position
 SetRecNo(RecNo);
end;

procedure TfmMain.SetRecNo(RecNo: integer);
begin
 tblView.RecNo := RecNo;
 if tblView.RecNo = RecNo then exit;
 if tblView.RecNo > RecNo then
  while (tblView.RecNo <> RecNo) and not tblView.BoF do tblView.Prior
 else
  while (tblView.RecNo <> RecNo) and not tblView.EoF do tblView.Next;
end;

procedure TfmMain.fpViewResize(Sender: TObject);
begin
 if not FCreated then exit;
{ NewHeight := ScalePixels(fpView.ClientHeight -10);
 if NewHeight < FMinDocHeight then NewHeight := FMinDocHeight;
 fpView.DocHeight := NewHeight;
 if Assigned(FCopyright) then
  FCopyright.Top := NewHeight - FCopyrightBottom;   }
 // Restart timer
 tmResize.Enabled := false;
 tmResize.Enabled := true;
end;

procedure TfmMain.WMExitSizeMove(var Message: TMessage);
begin
 inherited;
 BestFit;
 RebuildTable;
end;

procedure TfmMain.WMSysCommand(var Message: TWMSysCommand);
begin
 inherited;
 case Message.CmdType of
  SC_MAXIMIZE,
  SC_RESTORE:
    RebuildTable;
 end;
end;

procedure TfmMain.tmResizeTimer(Sender: TObject);
begin
 BestFit;
 RebuildTable;
end;

procedure TfmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_F1 then ShowAbout;
end;

end.