main.pas

delphi编程控件

      End;
End;

Procedure TColorComboBox.DrawItem(Index : Integer; Rect : TRect;
  State : TOwnerDrawState);
Const
  ColorWidth = 22;
Var
  ARect : TRect;
  Text : Array[0..255] Of Char;
  Safer : TColor;
Begin
  ARect := Rect;
  Inc(ARect.Top, 2);
  Inc(ARect.Left, 2);
  Dec(ARect.Bottom, 2);
  If FDisplayNames Then ARect.Right := ARect.Left + ColorWidth
  Else Dec(ARect.Right, 3);
  With Canvas Do Begin
      FillRect(Rect);
      Safer := Brush.Color;
      Pen.Color := clWindowText;
      Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
      Brush.Color := TColor(Items.Objects[Index]);
      Try
        InflateRect(ARect, -1, -1);
        FillRect(ARect);
      Finally
        Brush.Color := Safer;
      End;
      If FDisplayNames Then Begin
          StrPCopy(Text, Items[Index]);
          Rect.Left := Rect.Left + ColorWidth + 6;
          DrawText(Canvas.Handle, Text, StrLen(Text), Rect,
            {$IFDEF D4}
            DrawTextBiDiModeFlags(DT_SINGLELINE Or DT_VCENTER Or DT_NOPREFIX));
          {$ELSE}
            DT_SINGLELINE Or DT_VCENTER Or DT_NOPREFIX);
          {$ENDIF}
        End;
    End;
End;

Procedure TColorComboBox.Click;
Begin
  If ItemIndex >= 0 Then ColorValue := TColor(Items.Objects[ItemIndex]);
  Inherited Click;
End;

Procedure TColorComboBox.CMFontChanged(Var Message : TMessage);
Begin
  Inherited;
  ResetItemHeight;
  RecreateWnd;
End;

Procedure TColorComboBox.ResetItemHeight;
Begin
  //  ItemHeight := Max(GetItemHeight(Font), 9);
  ItemHeight := GetItemHeight(Font);
End;

Procedure TColorComboBox.DoChange;
Begin
  If Assigned(FOnChange) Then FOnChange(Self);
End;

Procedure TMainForm.DisplayHints(Sender : TObject);
Begin
  Sbar.Panels[0].Text := GetLongHint(Application.Hint);
End;

Procedure TMainForm.FormCreate(Sender : TObject);
Var
  IniFile : TIniFile;
Begin
  FontBox.Items.Assign(Screen.Fonts);
  ColorBox := TColorComBoBox.Create(Self);
  ColorBox.Parent := ToolBar971;
  ColorBox.Top := 1;
  ColorBox.Left := 444;
  ColorBox.Width := 53;
  ColorBox.Height := 19;
  ColorBox.DisplayNames := False;
  ColorBox.OnClick := CellColorBoxClick;
  // 在状态栏上加一个LABEL， 用于显示窗体坐标， 直接在窗体的状态栏上画坐标的话
  //因为 变化太快， 使 状态栏总是闪动
  ALabel:=Tlabel.Create(MainForm);
  ALabel.Parent := SBar;
  ALabel.Left:= SBar.Panels[0].Width + 4;
  ALabel.Width:= SBar.Panels[1].Width-2;
  ALabel.Top:=4;
  ALabel.Font.Color:=ClBlue;
  ALabel.Caption:='';

  IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
  WorkDir := inifile.readstring('WorkDir', 'Dir', '');
  Inifile.Free;
  application.OnHint := DisplayHints;

  Hwd := SetWindowsHookEx(WH_Mouse, CallBackProc, hInstance, 0);
  //Hook Mouse Message

  ReportControl1.Top := ReportControl1.Top + Dock971.Height + Dock972.Height;
  If ParamCount>=1 Then
  Begin
     ReportControl1.LoadFromFile(ParamStr(1));
     Ms_Cap1.CaptionText.Caption:=' -'+ParamStr(1);
  End;

End;

Procedure TMainForm.FileExitClick(Sender : TObject);
Begin
  Close;
End;


Procedure TMainForm.FileOpenClick(Sender : TObject);
Begin
  If thefile <> '' Then
    Begin
      Ms_Cap1.CaptionText.Caption := ' -' + theFile;
      ReportControl1.LoadFromFile(theFile);
      Exit;
    End
  Else
    //  If thefile = '' Then
    Begin
      If WorkDir <> '' Then OpenDialog1.InitialDir := WorkDir;
      If OpenDialog1.Execute Then
        Begin
          thefile := OpenDialog1.Filename;
          updateOldies(thefile, sender);
          Ms_Cap1.CaptionText.Caption := ' -' + OpenDialog1.Filename;
          ReportControl1.LoadFromFile(theFile);
        End;
    End;
  thefile := '';
End;

Procedure TMainForm.NewTableClick(Sender : TObject);
Begin
  Application.CreateForm(TfrmNewTable, frmNewTable);
  If frmNewTable.ShowModal = IDOK Then
    Begin
      ReportControl1.NewTable(StrToInt(frmNewTable.Edit2.Text), StrToInt(frmNewTable.Edit1.Text));
    End;
  TheFile := '未命名';
  Ms_Cap1.CaptionText.Caption := '未命名';
End;

Procedure TMainForm.FormResize(Sender : TObject);
Begin
  {  if IsWindow(ReportControl1.Handle) then
    begin
      if ClientRect.Right > ReportControl1.Width + 2 then
        ReportControl1.Left := (ClientRect.Right - ReportControl1.Width) div 2
      else
        ReportControl1.Left := 1;
    end;}
End;

Procedure TMainForm.InsertLineClick(Sender : TObject);
Begin
  ReportControl1.InsertLine;
End;

Procedure TMainForm.AddLineClick(Sender : TObject);
Begin
  ReportControl1.AddLine;
End;

Procedure TMainForm.CombineCellsClick(Sender : TObject);
Begin
  ReportControl1.CombineCell;
End;

Procedure TMainForm.SplitCellClick(Sender : TObject);
Begin
  ReportControl1.SplitCell;
End;

Procedure TMainForm.CellPropClick(Sender : TObject);
Var
  nDiagonal : UINT;
Begin
  If PropertyForm.ShowModal = mrOK Then
    Begin
      With PropertyForm Do
        Begin
          ReportControl1.SetCellLines(LeftLine.Checked, TopLine.Checked, RightLine.Checked, BottomLine.Checked,
            LeftLineWidth.Value, TopLineWidth.Value, RightLineWidth.Value, BottomLineWidth.Value);
          nDiagonal := 0;
          If LeftDiagonal1.Checked Then
            nDiagonal := nDiagonal Or LINE_LEFT1;

          If LeftDiagonal2.Checked Then
            nDiagonal := nDiagonal Or LINE_LEFT2;

          If LeftDiagonal3.Checked Then
            nDiagonal := nDiagonal Or LINE_LEFT3;

          If RightDiagonal1.Checked Then
            nDiagonal := nDiagonal Or LINE_RIGHT1;

          If RightDiagonal2.Checked Then
            nDiagonal := nDiagonal Or LINE_RIGHT2;

          If RightDiagonal3.Checked Then
            nDiagonal := nDiagonal Or LINE_RIGHT3;

          ReportControl1.SetCellDiagonal(nDiagonal);
          ReportControl1.SetCellColor(ForeColor, BackColor);
          ReportControl1.SetCellFont(CellFont);
          ReportControl1.SetCellAlign(HorzAlign.ItemIndex, VertAlign.ItemIndex);
        End;
    End;
End;

Procedure TMainForm.DeleteLineClick(Sender : TObject);
Begin
  ReportControl1.DeleteLine;
End;

Procedure TMainForm.AddCellClick(Sender : TObject);
Begin
  ReportControl1.AddCell;
End;

Procedure TMainForm.InsertCellClick(Sender : TObject);
Begin
  ReportControl1.InsertCell;
End;

Procedure TMainForm.DeleteCellClick(Sender : TObject);
Begin
  ReportControl1.DeleteCell;
End;

Procedure TMainForm.CellBorderLineClick(Sender : TObject);
Begin
  If BorderForm.ShowModal = mrOK Then
    With BorderForm Do
      ReportControl1.SetCellLines(LeftLine.Checked,
        TopLine.Checked,
        RightLine.Checked,
        BottomLine.Checked,
        1, 1, 1, 1);
End;

Procedure TMainForm.CellDiagonalLineClick(Sender : TObject);
Var
  nDiagonal : UINT;
Begin
  If DiagonalForm.ShowModal = mrOK Then
    Begin
      With DiagonalForm Do
        Begin
          nDiagonal := 0;
          If LeftDiagonal1.Checked Then
            nDiagonal := nDiagonal Or LINE_LEFT1;

          If LeftDiagonal2.Checked Then
            nDiagonal := nDiagonal Or LINE_LEFT2;

          If LeftDiagonal3.Checked Then
            nDiagonal := nDiagonal Or LINE_LEFT3;

          If RightDiagonal1.Checked Then
            nDiagonal := nDiagonal Or LINE_RIGHT1;

          If RightDiagonal2.Checked Then
            nDiagonal := nDiagonal Or LINE_RIGHT2;

          If RightDiagonal3.Checked Then
            nDiagonal := nDiagonal Or LINE_RIGHT3;
        End;
      ReportControl1.SetCellDiagonal(nDiagonal);
    End;
End;

Procedure TMainForm.CellFontClick(Sender : TObject);
Var
  CellFont : TLogFont;
Begin
  If FontDialog1.Execute Then
    Begin
      Windows.GetObject(FontDialog1.Font.Handle, SizeOf(CellFont), @CellFont);
      ReportControl1.SetCellFont(CellFont);
    End;
End;

Procedure TMainForm.CellColorClick(Sender : TObject);
Begin
  If ColorForm.ShowModal = mrOK Then
    Begin
      ReportControl1.SetCellColor(ColorForm.Panel1.Font.Color, ColorForm.Panel1.Color);
    End;
End;

Procedure TMainForm.CellAlignClick(Sender : TObject);
Begin
  If AlignForm.ShowModal = mrOK Then
    ReportControl1.SetCellAlign(AlignForm.HorzAlign.ItemIndex,
      AlignForm.VertAlign.ItemIndex);
End;

Procedure TMainForm.PageSetupClick(Sender : TObject);
Begin
  If PrinterSetupDialog1.Execute Then
    ReportControl1.CalcWndSize;
End;

Procedure TMainForm.FileSaveClick(Sender : TObject);
Begin
  If (Ms_Cap1.CaptionText.Caption = '') Or (Ms_Cap1.CaptionText.Caption = '未命名') Then
    Begin
      If WorkDir <> '' Then SaveDiaLog1.InitialDir := WorkDir;
      If SaveDialog1.Execute Then
        Begin
          ReportControl1.SaveToFile(SaveDialog1.FileName);
          thefile := SaveDialog1.Filename;
          Ms_Cap1.CaptionText.Caption := SaveDiaLog1.FileName;
          updateOldies(thefile, sender);
          thefile := '';
        End;
    End
  Else
    Begin
      ReportControl1.SaveToFile(Copy(Ms_Cap1.CaptionText.Caption, 3, Length(Ms_Cap1.CaptionText.Caption)));
    End;
End;

Procedure TMainForm.PrintItClick(Sender : TObject);
Begin
  ReportControl1.PrintIt;
End;

Procedure TMainForm.VSplitCellClick(Sender : TObject);
Begin
  If VSplitForm.ShowModal = mrOK Then
    ReportControl1.VSplitCell(VSplitForm.VSplitCount.Value);
End;

Procedure TMainForm.MarginSettingClick(Sender : TObject);
Var
  MarginRect : TRect;
Begin
  With MarginForm Do
    Begin
      MarginRect := ReportControl1.GetMargin;
      LeftMargin.Value := MarginRect.Left;
      TopMargin.Value := MarginRect.Top;
      RightMargin.Value := MarginRect.Right;
      BottomMargin.Value := MarginRect.Bottom;
      NewTableBox.Checked := ReportControl1.IsNewTable;
      LineCountEdit.Value := ReportControl1.DataLine;
      TableCountEdit.Value := ReportControl1.TablePerPage;
      //      EnableEditBox.Checked := ReportControl1.EnableEdit;
    End;

  If MarginForm.ShowModal = mrOK Then
    Begin
      With MarginForm Do
        Begin
          ReportControl1.SetMargin(LeftMargin.Value,
            TopMargin.Value,
            RightMargin.Value,
            BottomMargin.Value);

          ReportControl1.IsNewTable := NewTableBox.Checked;
          ReportControl1.DataLine := LineCountEdit.Value;
          ReportControl1.TablePerPage := TableCountEdit.Value;