main.pas

delphi编程控件

Unit main;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ReportControl, StdCtrls, Buttons, Menus, IniFiles, Wordcap, ComCtrls,
  ExtCtrls, TB97, TB97Tlbr, AnimatedMenus98, TB97Ctls, RXCombos;

Type

  TColorComboBox = Class(TCustomComboBox)
  Private
    FColorValue : TColor;
    FDisplayNames : Boolean;
    FColorNames : TStrings;
    FOnChange : TNotifyEvent;
    Procedure SetColorValue(NewValue : TColor);
    Procedure SetDisplayNames(Value : Boolean);
    Procedure SetColorNames(Value : TStrings);
    Procedure ColorNamesChanged(Sender : TObject);
    Procedure ResetItemHeight;
    Procedure CMFontChanged(Var Message : TMessage); Message CM_FONTCHANGED;
  Protected
    Procedure CreateWnd; Override;
    Procedure DrawItem(Index : Integer; Rect : TRect; State : TOwnerDrawState); Override;
    Procedure Click; Override;
    Procedure BuildList; Virtual;
    Procedure DoChange; Dynamic;
  Public
    Constructor Create(AOwner : TComponent); Override;
    Destructor Destroy; Override;
    Property Text;
  Published
    Property ColorValue : TColor Read FColorValue Write SetColorValue
      Default clBlack;
    Property ColorNames : TStrings Read FColorNames Write SetColorNames;
    Property DisplayNames : Boolean Read FDisplayNames Write SetDisplayNames
      Default True;
    Property Color;
    Property Ctl3D;
    Property DragMode;
    Property DragCursor;
    Property Enabled;
    Property Font;
    {$IFDEF RX_D4}
    Property Anchors;
    Property BiDiMode;
    Property Constraints;
    Property DragKind;
    Property ParentBiDiMode;
    {$ENDIF}
    {$IFDEF WIN32}
    {$IFNDEF VER90}
    Property ImeMode;
    Property ImeName;
    {$ENDIF}
    {$ENDIF}
    Property ParentColor;
    Property ParentCtl3D;
    Property ParentFont;
    Property ParentShowHint;
    Property PopupMenu;
    Property ShowHint;
    Property TabOrder;
    Property TabStop;
    Property Visible;
    Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
    Property OnClick;
    Property OnDblClick;
    Property OnDragDrop;
    Property OnDragOver;
    Property OnDropDown;
    Property OnEndDrag;
    Property OnEnter;
    Property OnExit;
    Property OnKeyDown;
    Property OnKeyPress;
    Property OnKeyUp;
    {$IFDEF WIN32}
    Property OnStartDrag;
    {$ENDIF}
    {$IFDEF D4}
    Property OnEndDock;
    Property OnStartDock;
    {$ENDIF}
  End;

  TMainForm = Class(TForm)
    MainMenu1 : TMainMenu;
    T1 : TMenuItem;
    N5 : TMenuItem;
    FileOpen : TMenuItem;
    FileExit : TMenuItem;
    N1 : TMenuItem;
    PageSetup : TMenuItem;
    T2 : TMenuItem;
    NewTable : TMenuItem;
    N3 : TMenuItem;
    InsertLine : TMenuItem;
    AddLine : TMenuItem;
    DeleteLine : TMenuItem;
    N4 : TMenuItem;
    CombineCells : TMenuItem;
    SplitCell : TMenuItem;
    N7 : TMenuItem;
    FileSave : TMenuItem;
    OpenDialog1 : TOpenDialog;
    N2 : TMenuItem;
    AddCell : TMenuItem;
    InsertCell : TMenuItem;
    DeleteCell : TMenuItem;
    CellBorderLine : TMenuItem;
    CellFont : TMenuItem;
    CellDiagonalLine : TMenuItem;
    CellColor : TMenuItem;
    FontDialog1 : TFontDialog;
    PrinterSetupDialog1 : TPrinterSetupDialog;
    CellAlign : TMenuItem;
    SaveDialog1 : TSaveDialog;
    PrintIt : TMenuItem;
    VSplitCell : TMenuItem;
    MarginSetting : TMenuItem;
    N6 : TMenuItem;
    PrintPreivew : TMenuItem;
    PopupMenu1 : TPopupMenu;
    N8 : TMenuItem;
    N9 : TMenuItem;
    N10 : TMenuItem;
    N11 : TMenuItem;
    N12 : TMenuItem;
    N13 : TMenuItem;
    N14 : TMenuItem;
    N15 : TMenuItem;
    N16 : TMenuItem;
    N17 : TMenuItem;
    N18 : TMenuItem;
    N19 : TMenuItem;
    N20 : TMenuItem;
    N21 : TMenuItem;
    N22 : TMenuItem;
    N23 : TMenuItem;
    N24 : TMenuItem;
    file1 : TMenuItem;
    FileClose : TMenuItem;
    ms_cap1 : TMSOfficeCaption;
    N26 : TMenuItem;
    SBar : TStatusBar;
    ScrollBox1 : TScrollBox;
    N27 : TMenuItem;
    N28 : TMenuItem;
    A1 : TMenuItem;
    N29 : TMenuItem;
    ReportControl1 : TReportControl;
    Dock971 : TDock97;
    MainMenu981 : TMainMenu98;
    Dock972 : TDock97;
    Toolbar971 : TToolbar97;
    ToolbarButton972 : TToolbarButton97;
    ToolbarButton973 : TToolbarButton97;
    ToolbarButton974 : TToolbarButton97;
    ToolbarButton975 : TToolbarButton97;
    ToolbarButton976 : TToolbarButton97;
    ToolbarButton977 : TToolbarButton97;
    ToolbarButton978 : TToolbarButton97;
    ToolbarButton979 : TToolbarButton97;
    ToolbarButton9710 : TToolbarButton97;
    ToolbarButton9711 : TToolbarButton97;
    ToolbarButton9712 : TToolbarButton97;
    ToolbarSep974 : TToolbarSep97;
    ToolbarSep975 : TToolbarSep97;
    ToolbarSep976 : TToolbarSep97;
    ToolbarSep979 : TToolbarSep97;
    FontBox : TComboBox;
    FontSizeBox : TComboBox;
    ToolbarButton9713 : TToolbarButton97;
    ToolbarSep9710 : TToolbarSep97;
    PopupMenu981 : TPopupMenu98;
    N25 : TMenuItem;
    N30 : TMenuItem;
    N31 : TMenuItem;
    ToolbarButton9714 : TToolbarButton97;
    Toolbar972 : TToolbar97;
    ToolbarButton971 : TToolbarButton97;
    ToolbarButton9715 : TToolbarButton97;
    ToolbarButton9716 : TToolbarButton97;
    CellColorBtn : TToolbarButton97;
    ToolbarButton9717 : TToolbarButton97;
    Procedure FormCreate(Sender : TObject);
    Procedure FileExitClick(Sender : TObject);
    Procedure FileOpenClick(Sender : TObject);
    Procedure NewTableClick(Sender : TObject);
    Procedure FormResize(Sender : TObject);
    Procedure InsertLineClick(Sender : TObject);
    Procedure AddLineClick(Sender : TObject);
    Procedure CombineCellsClick(Sender : TObject);
    Procedure SplitCellClick(Sender : TObject);
    Procedure CellPropClick(Sender : TObject);
    Procedure DeleteLineClick(Sender : TObject);
    Procedure AddCellClick(Sender : TObject);
    Procedure InsertCellClick(Sender : TObject);
    Procedure DeleteCellClick(Sender : TObject);
    Procedure CellBorderLineClick(Sender : TObject);
    Procedure CellDiagonalLineClick(Sender : TObject);
    Procedure CellFontClick(Sender : TObject);
    Procedure CellColorClick(Sender : TObject);
    Procedure CellAlignClick(Sender : TObject);
    Procedure PageSetupClick(Sender : TObject);
    Procedure FileSaveClick(Sender : TObject);
    Procedure PrintItClick(Sender : TObject);
    Procedure VSplitCellClick(Sender : TObject);
    Procedure MarginSettingClick(Sender : TObject);
    Procedure PrintPreivewClick(Sender : TObject);
    Procedure UpdateOldies(thefile : String; sender : tobject);
    Procedure RecentFile1(sender : tobject);
    Procedure RecentFile2(sender : tobject);
    Procedure RecentFile3(sender : tobject);
    Procedure RecentFile4(sender : tobject);
    Procedure RecentFile5(sender : tobject);
    Procedure RecentFile6(sender : tobject);
    Procedure RecentFile7(sender : tobject);
    Procedure RecentFile8(sender : tobject);
    Procedure RecentFile9(sender : tobject);
    Procedure T1Click(Sender : TObject);
    Procedure FileCloseClick(Sender : TObject);
    Procedure N25Click(Sender : TObject);
    Procedure N27Click(Sender : TObject);
    Procedure N28Click(Sender : TObject);
    Procedure A1Click(Sender : TObject);
    Procedure N29Click(Sender : TObject);
    Procedure DisplayHints(Sender : TObject);
    Procedure ToolbarButton977Click(Sender : TObject);
    Procedure N31Click(Sender : TObject);
    Procedure CellColorBtnClick(Sender : TObject);
    Procedure CellColorBoxClick(Sender : TObject);
    Procedure FontBoxChange(Sender : TObject);
    Procedure FormClose(Sender : TObject; Var Action : TCloseAction);
    procedure SBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);

  Private
    { Private declarations }
  Public
    { Public declarations }

  End;


Const
  DefIni = 'EReport.ini';

Var
  MainForm : TMainForm;
  thefile : String;
  WorkDir : String;
  ColorBox : TColorComboBox;
  ALabel : TLabel;
  Hwd : THandle;

Function GetItemHeight(Font : TFont) : Integer;
Function CallBackProc(Code : integer; wParam : wParam; Lparam : Lparam) : Longint;
{$IFDEF Win32}stdCall;
{$ELSE}Export;
{$ENDIF}

Implementation

Uses NewDialog, PropDlg, Border, diagonal, Color, Align, vsplit, margin, SetWorkPlace,
  About;

{$R *.DFM}


{ TColorComboBox }
Const
  ColorsInList = 16;
  ColorValues : Array[0..ColorsInList - 1] Of TColor = (
    clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray,
    clSilver, clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clWhite);


Function GetItemHeight(Font : TFont) : Integer;
Var
  DC : HDC;
  SaveFont : HFont;
  Metrics : TTextMetric;
Begin
  DC := GetDC(0);
  Try
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
  Finally
    ReleaseDC(0, DC);
  End;
  Result := Metrics.tmHeight + 1;
End;

Constructor TColorComboBox.Create(AOwner : TComponent);
Begin
  Inherited Create(AOwner);
  Style := csOwnerDrawFixed;
  FColorValue := clBlack;
  FColorNames := TStringList.Create;
  TStringList(FColorNames).OnChange := ColorNamesChanged;
  FDisplayNames := False;
End;

Destructor TColorComboBox.Destroy;
Begin
  TStringList(FColorNames).OnChange := Nil;
  FColorNames.Free;
  FColorNames := Nil;
  Inherited Destroy;
End;

Procedure TColorComboBox.CreateWnd;
Begin
  Inherited CreateWnd;
  BuildList;
  SetColorValue(FColorValue);
End;

Procedure TColorComboBox.BuildList;
Var
  I : Integer;
  ColorName : String;
Begin
  Clear;
  For I := 0 To Pred(ColorsInList) Do Begin
      If (I <= Pred(FColorNames.Count)) And (FColorNames[I] <> '') Then
        ColorName := FColorNames[I]
      Else
        ColorName := Copy(ColorToString(ColorValues[I]), 3, MaxInt);
      Items.AddObject(ColorName, TObject(ColorValues[I]));
    End;
End;

Procedure TColorComboBox.ColorNamesChanged(Sender : TObject);
Begin
  If HandleAllocated Then Begin
      FColorValue := ColorValue;
      RecreateWnd;
    End;
End;

Procedure TColorComboBox.SetColorNames(Value : TStrings);
Begin
  FColorNames.Assign(Value);
End;

Procedure TColorComboBox.SetDisplayNames(Value : Boolean);
Begin
  If DisplayNames <> Value Then Begin
      FDisplayNames := Value;
      Invalidate;
    End;
End;

Procedure TColorComboBox.SetColorValue(NewValue : TColor);
Var
  Item : Integer;
  CurrentColor : TColor;
Begin
  If (ItemIndex < 0) Or (NewValue <> FColorValue) Then
    { change selected item }
    For Item := 0 To Pred(Items.Count) Do Begin
        CurrentColor := TColor(Items.Objects[Item]);
        If CurrentColor = NewValue Then Begin
            FColorValue := NewValue;
            If ItemIndex <> Item Then ItemIndex := Item;
            DoChange;
            Break;
          End;