⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 DelphiHelper---Delphi帮助源代码
💻 PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, RzTabs, RzPanel, ExtCtrls, StdCtrls, RzLabel, ComCtrls,
  RzTreeVw, RzEdit, RzLstBox, RzStatus, RzSplit, RzTray, Grids, DBGrids,
  RzButton, ImgList, Buttons, Mask, DBCtrls, RzDBEdit, RzBorder, RzTrkBar,
  RzDBNav;

type
  Tfrmmain = class(TForm)
    RzPageControl1: TRzPageControl;
    RzStatusBar1: TRzStatusBar;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    RzStatusPane1: TRzStatusPane;
    RzSplitter1: TRzSplitter;
    RzPanel1: TRzPanel;
    RzLabel1: TRzLabel;
    RzPageControl2: TRzPageControl;
    TabSheet3: TRzTabSheet;
    TreeView1: TRzTreeView;
    TabSheet4: TRzTabSheet;
    ListBox1: TRzListBox;
    RzTrayIcon1: TRzTrayIcon;
    TabSheet5: TRzTabSheet;
    StringGrid1: TStringGrid;
    TabSheet6: TRzTabSheet;
    RzToolbar2: TRzToolbar;
    DBGrid1: TDBGrid;
    RzPanel2: TRzPanel;
    ImageList1: TImageList;
    BtnNew: TRzToolButton;
    BtnEdit: TRzToolButton;
    BtnDelete: TRzToolButton;
    RzPanel3: TRzPanel;
    RzToolbar1: TRzToolbar;
    RzToolButton1: TRzToolButton;
    RzEdit1: TRzEdit;
    RzToolButton2: TRzToolButton;
    RzToolButton3: TRzToolButton;
    SpeedButton1: TSpeedButton;
    RzLabel2: TRzLabel;
    RichEdit1: TRzMemo;
    BtnPrint: TRzToolButton;
    TabSheet7: TRzTabSheet;
    RzSplitter2: TRzSplitter;
    RzPanel4: TRzPanel;
    RzEdit2: TRzEdit;
    RzPageControl3: TRzPageControl;
    TabSheet8: TRzTabSheet;
    DBGrid2: TDBGrid;
    RzToolbar4: TRzToolbar;
    RzToolButton4: TRzToolButton;
    RzToolButton5: TRzToolButton;
    RzToolButton6: TRzToolButton;
    BtnPrint1: TRzToolButton;
    RzSpacer1: TRzSpacer;
    RzSpacer2: TRzSpacer;
    SpeedButton2: TSpeedButton;
    RzDBMemo1: TRzDBMemo;
    RzDBEdit1: TRzDBEdit;
    RzLabel3: TRzLabel;
    RzTrackBar2: TRzTrackBar;
    RzTrackBar3: TRzTrackBar;
    RzLabel5: TRzLabel;
    RzLabel6: TRzLabel;
    RzLabel4: TRzLabel;
    RzTrackBar1: TRzTrackBar;
    RzBitBtn1: TRzBitBtn;
    RzToolbar3: TRzToolbar;
    BtnHelp: TRzToolButton;
    BtnInformation: TRzToolButton;
    RzSpacer3: TRzSpacer;
    RzToolButton7: TRzToolButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    H1: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N9: TMenuItem;
    RzPageControl4: TRzPageControl;
    TabSheet9: TRzTabSheet;
    TabSheet10: TRzTabSheet;
    RzToolbar5: TRzToolbar;
    DBGrid3: TDBGrid;
    RzDBNavigator1: TRzDBNavigator;
    RzToolbar6: TRzToolbar;
    RzDBNavigator2: TRzDBNavigator;
    RzDBEdit2: TRzDBEdit;
    RzDBDateTimeEdit1: TRzDBDateTimeEdit;
    RzDBMemo2: TRzDBMemo;
    RzLabel7: TRzLabel;
    RzLabel8: TRzLabel;
    RzLabel9: TRzLabel;
    RzToolButton8: TRzToolButton;
    RzToolButton9: TRzToolButton;
    RzToolButton10: TRzToolButton;
    PopupMenu1: TPopupMenu;
    A1: TMenuItem;
    N2: TMenuItem;
    RzStatusPane2: TRzStatusPane;
    RzStatusPane3: TRzStatusPane;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure SpeedButton1Click(Sender: TObject);
    procedure RzEdit1KeyPress(Sender: TObject; var Key: Char);
    procedure ListBox1Click(Sender: TObject);
    procedure RzToolButton2Click(Sender: TObject);
    procedure RzToolButton3Click(Sender: TObject);
    procedure RzToolButton1Click(Sender: TObject);
    procedure RzEdit2Change(Sender: TObject);
    procedure RzToolButton4Click(Sender: TObject);
    procedure RzToolButton6Click(Sender: TObject);
    procedure RzToolButton5Click(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure RzTrackBar1Change(Sender: TObject);
    procedure RzToolButton8Click(Sender: TObject);
    procedure RzToolButton7Click(Sender: TObject);
    procedure BtnInformationClick(Sender: TObject);
    procedure RzToolButton10Click(Sender: TObject);
    procedure BtnPrintClick(Sender: TObject);
    procedure BtnPrint1Click(Sender: TObject);
    procedure BtnHelpClick(Sender: TObject);
  private
    { Private declarations }
   // tx,ty : integer;
   // procedure WMEraseBkng(var MSg:TWMEraseBkgnd);message WM_ERASEBKGND;
  public
    { Public declarations }
    procedure creattree;
  end;

var
  frmmain: Tfrmmain;
implementation

uses data, arcedit, arcadd, about, funadd, funedit, logslt;

{$R *.dfm}
//const
//  Digits : array[0..$F] of Char = '0123456789ABCDEF';

{function HexB(B : Byte) : string;
begin
  HexB:=Digits[B shr 4]+Digits[B and $F];
end;
procedure tfrmmain.WMEraseBkng(var MSg:TWMEraseBkgnd);
begin
  Msg.Result:=1;
end;
}

procedure Tfrmmain.creattree;
var
node0,node1:TTreeNode;
a1,b1:string;
begin
treeview1.Items.Clear;
with dm do
 begin
   query1.Close;
   query1.SQL.Clear;
   query1.SQL.Add('select distinct Article_Type from Article ');
   query1.Prepared;
   query1.Open;
   while not query1.Eof do
     begin
     a1:=query1.Fields[0].AsString;
     node0:=TreeView1.Items.Add(nil,a1);
     query2.Close;
     query2.SQL.Clear;
     query2.SQL.Add('select distinct Article_Title from Article '+' where Article_Type='+''''+a1+'''');
     query2.Prepared;
     query2.Open;
     while not query2.Eof do
       begin
       b1:=query2.Fields[0].AsString;
       node1:=TreeView1.Items.AddChild(node0,b1);
       query2.Next;
       end;
     query1.Next;
     end;
     query3.Close;
     query3.SQL.Clear;
     query3.SQL.Add('select count(*) from Article '+' where Article_ID is not null');
     query3.Prepared;
     query3.Open;
     RzStatusPane1.Caption:='共有技术文章: '+query3.Fields[0].AsString +'篇';
end;
end;

function replacing(S,source,target:string):string;
var site,StrLen:integer;
begin
site:=pos(source,s);
StrLen:=length(source);
delete(s,site,StrLen);
insert(target,s,site);
replacing:=s;
end;

procedure Tfrmmain.FormCreate(Sender: TObject);
var
i,j:integer;
str:string;
begin
str:=ExtractFileDir(Application.Exename)+'\data\data.mdb';
if not fileexists(str) then
  begin
   showmessage('没有找到数据库文件!');
   application.Terminate;
  end;
with dm do
begin
   Conn1.Close;
   Conn1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source='+str+
   ';Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database="";Jet OLEDB:Registry '+
   'Path="";Jet OLEDB:Database Password="tgmsoft";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=1;'+
   'Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database '+
   'Password="tgmsoft";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:'+
   'Don'+''''+'t Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
   conn1.LoginPrompt:=false;
   conn1.Connected;
   set_log.Active:=true;
   query4.Active:=true;
   set_Arc.Active:=true;
end;
frmmain.creattree;
i:=0;
while i<=15 do
  begin
    j:=0;
    while j<=8 do
      begin
        StringGrid1.Cells[j,i]:=inttostr(i*8+j+1)+':    '+chr(i*8+j+1);
        j:=j+1;
      end;
    i:=i+1;
  end;
end;


procedure Tfrmmain.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
nd:TTreeNode;
begin
with dm do
 begin
 nd:=treeview1.Selected;
 if nd.Level=1 then
    begin
    query3.Close;
    query3.SQl.Clear;
    query3.SQL.Add('select Article_text from Article where Article_title='+''''+nd.Text+'''');
    query3.Prepared;
    query3.Open;
    rzlabel1.Caption:=nd.Text;
    RichEdit1.Text:=query3.Fields[0].AsString;
    end
 else
    begin
    rzlabel1.Caption:='';
    richedit1.Text:='';
    end;
 end;
end;

procedure Tfrmmain.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
str:string;
a1:integer;
begin
a1:=Pos(':    ',StringGrid1.Cells[acol,arow])+1;
str:='ASCII码为:    '+copy(stringgrid1.Cells[acol,arow],a1,5)+chr(13)+
     '10进制ASCII码为:  '+inttostr(Arow*8+Acol+1)+chr(13)+
     '16进制ASCII码为:  '+inttohex(Arow*8+Acol+1,2);
MessageBox(Handle, pchar(str), '显示ASCII码', MB_ICONASTERISK);
end;

procedure Tfrmmain.SpeedButton1Click(Sender: TObject);
var
str:string;
begin
str:=replacing(rzedit1.Text,'+',RzLabel2.Caption);
frmmain.ListBox1.Clear;
with dm do
 begin
 query1.Close;
 query1.SQL.Clear;
 query1.SQL.Add('select Article_Title from Article where Article_Title like '+''''+'%'+str+'%'+'''');    //+' and Article_text like '+''''+'%'+rzedit2.Text+'%'+''''
 //showmessage(query1.SQL.Text);
 query1.Prepared;
 query1.Open;
 while not query1.Eof do
  begin
  frmmain.ListBox1.Items.Add(query1.Fields[0].asstring);
  query1.Next;
  end;
showmessage('共搜索到'+inttostr(query1.RecordCount)+'条记录!');
end;
tabsheet4.Show;
end;

procedure Tfrmmain.RzEdit1KeyPress(Sender: TObject; var Key: Char);
begin
if key=chr(13) then SpeedButton1.Click;
end;

procedure Tfrmmain.ListBox1Click(Sender: TObject);
var
i:integer;
str:string;
begin
i:=listbox1.ItemIndex;
str:=trim(listbox1.Items.Strings[i]);
with dm do
 begin
    query3.Close;
    query3.SQl.Clear;
    query3.SQL.Add('select Article_text from Article where Article_title='+''''+str+'''');
    query3.Prepared;
    query3.Open;
    rzlabel1.Caption:=str;
    RichEdit1.Text:=query3.Fields[0].AsString;
end;
end;

procedure Tfrmmain.RzToolButton2Click(Sender: TObject);
begin
if rzlabel1.Caption<>'' then
begin
with dm do
 begin
  frmarcedit.RzDBComboBox1.Clear;
  query1.Close;
  query1.SQL.Clear;
  query1.SQL.Add('select distinct Article_Type from Article where Article_Type is not null');
  query1.Prepared;
  query1.Open;
  while not query1.Eof do
   begin
    frmarcedit.RzDBComboBox1.Items.Add(trim(query1.Fields[0].asstring));
    query1.Next;
   end;
  Set_Arc_edit.Close;
  Set_Arc_edit.CommandText:='';
  Set_Arc_edit.CommandText:='select * from Article where Article_Title='+''''+trim(rzlabel1.Caption)+'''';
  Set_Arc_edit.Open;
  Set_Arc_edit.Edit;
  frmarcedit.ShowModal;
 end;
end;
end;

procedure Tfrmmain.RzToolButton3Click(Sender: TObject);
begin
if trim(rzlabel1.Caption)<>'' then
begin
with dm do
 begin
  if MessageBox(Handle, '确定要删除该文章吗?', 'Question', MB_ICONQUESTION or MB_YESNO) = IDYES then
  begin
  query3.Close;
  query3.SQL.Clear;
  query3.SQL.Add('delete from Article where Article_Title='+''''+trim(rzlabel1.Caption)+'''');
  query3.ExecSQL;
  frmmain.creattree;
  end;
 end;
end;
end;

procedure Tfrmmain.RzToolButton1Click(Sender: TObject);
begin
with dm do
  begin
  Set_Arc_add.Active:=true;
  Set_Arc_add.Append;
  end;
frmarcadd.ShowModal;
end;

procedure Tfrmmain.RzEdit2Change(Sender: TObject);
var
str,str1:string;
begin
str:='select fun_id,fun_name,fun_exp from tbl_function where fun_name is not null ';
  if rzedit2.Text=''  then
    str1:=''
    else
    str1:=' and fun_name like '+''''+'%'+ rzedit2.Text+'%'+'''';
with dm do
 begin
  query4.Close;
  query4.SQL.clear;
  query4.SQL.Add(str+str1);
  query4.Prepared;
  query4.Open;
 end;
end;

procedure Tfrmmain.RzToolButton4Click(Sender: TObject);
begin
with dm do
  begin
  Set_Func_add.Active:=true;
  Set_Func_add.Append;
  end;
frmfunadd.ShowModal;
end;

procedure Tfrmmain.RzToolButton6Click(Sender: TObject);
begin
if trim(RzDBEdit1.Text)<>'' then
begin
with dm do
 begin
  if MessageBox(Handle, '确定要删除该记录吗?', 'Question', MB_ICONQUESTION or MB_YESNO) = IDYES then
  begin
  query3.Close;
  query3.SQL.Clear;
  query3.SQL.Add('delete from tbl_function where fun_name='+''''+trim(RzDBEdit1.Text)+'''');
  query3.ExecSQL;
  rzedit2.Text:='';
  end;
 end;
end;
end;

procedure Tfrmmain.RzToolButton5Click(Sender: TObject);
begin
if RzDBEdit1.Text<>'' then
begin
with dm do
 begin
  Set_Func_edit.Close;
  Set_Func_edit.CommandText:='';
  Set_Func_edit.CommandText:='select * from tbl_function where fun_name='+''''+trim(RzDBEdit1.Text)+'''';
  Set_Func_edit.Open;
  Set_Func_edit.Edit;
  frmfunedit.ShowModal;
 end;
end;
end;

procedure Tfrmmain.DBGrid1CellClick(Column: TColumn);
var
a,b,c:byte;
begin
with dm do
begin
a:=set_color.FieldValues['color_r'];
b:=set_color.FieldValues['color_g'];
c:=set_color.FieldValues['color_b'];
rztrackbar1.Position:=a;
rztrackbar2.Position:=b;
rztrackbar3.Position:=c;
rzlabel3.Color:=rgb(a,b,c);
end;
end;

procedure Tfrmmain.RzTrackBar1Change(Sender: TObject);
begin
rzlabel3.Color:=rgb(rztrackbar1.Position,rztrackbar2.Position,rztrackbar3.Position);
rzlabel4.Caption:='R:  '+inttostr(rztrackbar1.Position);
rzlabel5.Caption:='G:  '+inttostr(rztrackbar2.Position);
rzlabel6.Caption:='B:  '+inttostr(rztrackbar3.Position);
//rzlabel7.Caption:=inttohex(rztrackbar1.Position)+inttohex(rztrackbar2.Position)+inttohex(rztrackbar3.Position)
end;

procedure Tfrmmain.RzToolButton8Click(Sender: TObject);
begin
frmlogslt.Show;
end;

procedure Tfrmmain.RzToolButton7Click(Sender: TObject);
begin
close;
end;

procedure Tfrmmain.BtnInformationClick(Sender: TObject);
begin
frmabout.ShowModal;
end;

procedure Tfrmmain.RzToolButton10Click(Sender: TObject);
begin
with dm do
ppreport1.Print;
end;

procedure Tfrmmain.BtnPrintClick(Sender: TObject);
begin
if rzlabel1.Caption<>'' then
begin
with dm do
 begin
  Set_Arc.Close;
  Set_Arc.CommandText:='';
  Set_Arc.CommandText:='select * from Article where Article_Title='+''''+trim(rzlabel1.Caption)+'''';
  Set_Arc.Open;
  ppReport2.Print;
 end;
end;
end;

procedure Tfrmmain.BtnPrint1Click(Sender: TObject);
begin
if rzdbedit1.Text<>'' then
begin
with dm do
 begin
  Set_Fun.Close;
  Set_Fun.CommandText:='';
  Set_Fun.CommandText:='select * from tbl_function where fun_name='+''''+trim(rzdbedit1.Text)+'''';
  Set_Fun.Open;
  ppReport3.Print;
 end;
end;
end;

procedure Tfrmmain.BtnHelpClick(Sender: TObject);
begin
showmessage('^_^,改日再写!请见谅!');
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -