main.pas

delphi编程控件

          //          ReportControl1.EnableEdit := EnableEditBox.Checked;
        End;
    End;
End;

Procedure TMainForm.PrintPreivewClick(Sender : TObject);
Begin
  //    reportcontrol1.p
End;

Procedure TMainForm.FileCloseClick(Sender : TObject);
Begin
  If Application.Messagebox('确实要关闭文件吗？', '警告', MB_OKCANCEL) = MrOK Then
    Begin
      thefile := '';
      Ms_Cap1.CaptionText.Caption := '';
      ReportControl1.ResetContent;
    End;
End;



{ wang han song Add }

Procedure TMainForm.updateoldies(thefile : String; sender : tobject);
Var
  A, B, C, holder : String;
  n, m : integer;
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    A := uppercase(thefile);
    holder := A;
    For n := 1 To 10 Do
      Begin
        B := inifile.readstring('Oldies', inttostr(n), '');
        If b = holder Then
          Begin
            inifile.writestring('Oldies', inttostr(n), 'filepath');
            B := inifile.readstring('Oldies', inttostr(n), '');
          End;
        inifile.writestring('Oldies', inttostr(n), A);
        A := B;
      End;
  Finally
    inifile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile1(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '1', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile2(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '2', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile3(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '3', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile4(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '4', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile5(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '5', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile6(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '6', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile7(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '7', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile8(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '8', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.RecentFile9(sender : tobject);
Var
  IniFile : TIniFile;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    thefile := inifile.readstring('Oldies', '9', '');
    FileOpenClick(sender);
  Finally
    IniFile.Free;
    thefile := '';
  End;
End;

Procedure TMainForm.T1Click(Sender : TObject);
Var
  NewItem : TMenuItem;
  count, A, B, wipe : String;
  n, m : integer;
  IniFile : TIniFile;
Label
  redo;
Begin
  Try
    IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
    While file1.count > 0 Do
      file1.Delete(0);
    For n := 1 To 9 Do
      Begin
        count := inttostr(n);
        redo : //循环开始
        A := inifile.readstring('Oldies', count, '');
        If A = '' Then exit;
        If Not fileexists(A) Then
          Begin
            For m := strtoint(count) To 10 Do
              Begin
                B := inifile.readstring('Oldies', inttostr(m + 1), '');
                inifile.writestring('Oldies', inttostr(m), B);
                wipe := inttostr(m + 1);
              End;
            inifile.writestring('Oldies', wipe, '');
            Goto redo; //循环结束
          End;
        NewItem := TMenuItem.Create(Self);
        NewItem.Caption := '&' + count + ' ' + A;
        Case n Of
          1 : newitem.onclick := RecentFile1;
          2 : newitem.onclick := RecentFile2;
          3 : newitem.onclick := RecentFile3;
          4 : newitem.onclick := RecentFile4;
          5 : newitem.onclick := RecentFile5;
          6 : newitem.onclick := RecentFile6;
          7 : newitem.onclick := RecentFile7;
          8 : newitem.onclick := RecentFile8;
          9 : newitem.onclick := RecentFile9;
        End;
        //    File1.Insert(n-1, NewItem);
        File1.Add(NewItem);
      End;
  Finally
    IniFile.Free;
  End;
End;

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

Procedure TMainForm.N27Click(Sender : TObject);
Begin
  If WorkDir <> '' Then SaveDiaLog1.InitialDir := WorkDir;
  If SaveDialog1.Execute Then
    Begin
      ReportControl1.SaveToFile(SaveDialog1.FileName);
      thefile := SaveDialog1.Filename;
      updateOldies(thefile, sender);
      Ms_Cap1.CaptionText.Caption := ' -' + thefile;
      thefile := '';
    End;
End;

Procedure TMainForm.N28Click(Sender : TObject);
Var
  IniFile : TIniFile;
Begin
  Application.CreateForm(TFrm_SetWorkPlace, Frm_SetWorkPlace);
  If Frm_SetWorkPlace.ShowModal = MrOk Then
    Begin
      WorkDir := Frm_SetWorkPlace.DirectoryListBox1.Directory;
      SBar.Panels[1].Text := WorkDir;
      Try
        IniFile := TIniFile.create(ExtractFilePath(ParamStr(0)) + defini);
        IniFile.WriteString('WorkDir', 'Dir', WorkDir);
      Finally
        IniFile.Free;
      End;
    End;
End;

Procedure TMainForm.A1Click(Sender : TObject);
Begin
  Application.CreateForm(Tfrm_About, frm_About);
  frm_About.ShowModal;
End;

Procedure TMainForm.N29Click(Sender : TObject);
Begin
  application.CreateForm(TPropertyForm, PropertyForm);
  PropertyForm.ShowModal;
End;



Procedure TMainForm.ToolbarButton977Click(Sender : TObject);
Begin
  ReportControl1.SetCellAlignHorzAlign(TToolBarButton97(Sender).Tag);
End;


Procedure TMainForm.N31Click(Sender : TObject);
Begin
  Reportcontrol1.SetCellAlignNewVertAlign(TMenuItem(Sender).Tag);
End;

Procedure TMainForm.CellColorBtnClick(Sender : TObject);
Begin
  If CellColorBtn.Caption = '前' Then CellColorBtn.Caption := '背'
  Else CellcolorBtn.Caption := '前';
End;

Procedure TMainForm.CellColorBoxClick(Sender : TObject);
Begin
  If CellColorBtn.Caption = '前' Then
    ReportControl1.SetCellTextColor(ColorBox.ColorValue)
  Else
    ReportControl1.SetCellBackColor(ColorBox.ColorValue);
End;

Procedure TMainForm.FontBoxChange(Sender : TObject);
Var
  CellFont : TLogFont;
  AFont : TFont;
Begin
//别动下面的东东哦，嘿嘿，把注释去掉不知道为什么出错，唉，水平问题
//LogFont好奇妙 Wang Han Song
{  Try
    AFont := TFont.Create;
    AFont := ReportControl1.GetCellFont;
    If Afont <> Nil Then
      Begin

        //AFont.Name := FontBox.Items[FontBox.ItemIndex];
    //    ShowMessage(AFont.Name);
        Windows.GetObject(AFont.Handle, SizeOf(CellFont), @CellFont);
        ReportControl1.SetCellFont(CellFont);
      End;
  Finally
    If AFont <> Nil Then
      AFont.Free;
  End;}
End;

// add by Wang Han Song  谁帮我解决CALL BACK函数里那段处理自动滚动滚动条没反映的问题呢
Procedure TMainForm.FormClose(Sender : TObject; Var Action : TCloseAction);
Begin
  unHookWindowsHookEx(hwd);
End;

Function CallBackProc(Code : integer; wParam : wParam; Lparam : Lparam) : Longint;
Var
  CursorPos : TPoint;
  WindowRect : TRect;
Begin
  Windows.GetCursorPos(CursorPos);
  Main.ALabel.Caption := IntToStr(CurSorPos.x) + ':' + IntToStr(CurSorPos.y);
  GetWindowRect(MainForm.ReportControl1.Parent.Handle, WindowRect);
//  MainForm.Sbar.panels[0].Text := IntToStr(WindowRect.Top) + ':' + IntToStr(WindowRect.Bottom);

  // ??????? 明明钩住了，怎么下面的没反映？ 奇怪奇怪
  If (CursorPos.y <= WindowRect.Top + 15) Then
    If TScrollBox(MainForm.ReportControl1.Owner).VertScrollBar.Position > 0 Then
      TScrollBox(MainForm.ReportControl1.Owner).VertScrollBar.Position := TScrollBox(MainForm.ReportControl1.Owner).VertScrollBar.Position - 15;
  // 向下滚动
  If (CursorPos.y >= WindowRect.Bottom - 15) Then
    If TScrollBox(MainForm.ReportControl1.Owner).VertScrollBar.Position < TScrollBox(MainForm.ReportControl1.Owner).VertScrollBar.Range Then
      TScrollBox(MainForm.ReportControl1.Owner).VertScrollBar.Position := TScrollBox(MainForm.ReportControl1.Owner).VertScrollBar.Position + 15;

  Result := CallNextHookEx(Hwd, Code, wParam, lParam);

End;
procedure TMainForm.SBarDrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
   with SBar.Canvas do
  begin
    Brush.Color := $000D1B44;
    FillRect(Rect);

    Font.Color := clYellow;
    TextOut(Rect.Left + 30, Rect.top +1,'献给北京Delphi程序员开发者大会 1999.03.07');

  end;

end;

End.