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

📄 rl_unit1.pas

📁 一个很不错的绿色小软件 可以实现 上网 一个小助手
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    4:Result:=' (雨水)';
    5:Result:=' (惊蛰)';
    6:Result:=' {春分)';
    7:Result:=' (清明)';
    8:Result:=' (谷雨)';
    9:Result:=' (立夏)';
    10:Result:=' (小满)';
    11:Result:=' (芒种)';
    12:Result:=' (夏至)';
    13:Result:=' (小暑)';
    14:Result:=' (大暑)';
    15:Result:=' (立秋)';
    16:Result:=' (处暑)';
    17:Result:=' (白露)';
    18:Result:=' (秋分)';
    19:Result:=' (寒露)';
    20:Result:=' (霜降)';
    21:Result:=' (立冬)';
    22:Result:=' (小雪)';
    23:Result:=' (大雪)';
    24:Result:=' (冬至)';
  end;
end;

function GetLunarHolDay(iYear,iMonth,iDay:Word):string;
begin
  Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;

//--------------------------------------------------------------------------------------------------------
//--------------------------------------------------------------------------------------------------------

//返回label51的值:农历年月日,星期
function title_inf(iYear,iMonth,iDay:word):string; 
Begin
  Form3.l_CalcLunarDate(iYear,iMonth,iDay,CalcDateDiff(EncodeDate(iYear,iMonth,iDay),EncodeDate(START_YEAR,1,1)));
  result:=FormatLunarYear(iYear)+FormatMonth(iMonth)+FormatLunarDay(iDay);
End;
//-------------------------------------------------------------------
//根据日期显示日历内容
procedure TForm3.loadsunli(iYear,iMonth:word);
var
startday,lenmonth:integer;//记录某月第一天是周几,某月有多少天
i,j:integer;
k:word;
str:string;
FirstDate:TdateTime;
begin
    FirstDate:=EncodeDate(iYear,iMonth,1);
    startday:=DayofWeek(FirstDate);
    lenmonth:=MonthDays(iYear,iMonth);
    j:=0;
    while j<startday-1 do  //隐藏1号以前的label标签
    begin
      (Form3.Components[j+3] as TFlatButton).Visible:=false;
      j:=j+1;
    end;
    k:=1;    //FormatMonth(iMonth) + FormatLunarDay(iDay)
    For i:=startday-1 to lenmonth+startday-2 do //读出当前日期显示
    begin
      str:=GetLunarHolDay(iYear,iMonth,k);
      //ShowMessage(GetLunarHolDay(iYear,iMonth,yl_day));
      (Form3.Components[i+3] as TFlatButton).Caption:=IntToStr(k); //GetLunarHolDay(iYear,iMonth,k)
      (Form3.Components[i+3] as TFlatButton).Tag:=k;
      (Form3.Components[i+3] as TFlatButton).ColorHighLight:=clSkyBlue;
      (Form3.Components[i+3] as TFlatButton).ColorShadow:=clSkyBlue;
      (Form3.Components[i+3] as TFlatButton).OnClick:=FlatButtonClick;
      (Form3.Components[i+3] as TFlatButton).OnMouseEnter:=FlatButtonMouseEnter;
      (Form3.Components[i+3] as TFlatButton).PopupMenu:=Form3.rl_pm1;
      (Form3.Components[i+3] as TFlatButton).Color:=$00F8E4D8;
      If (rl_year.Text=IntToStr(yearof(Date))) and(rl_month.Text=IntToStr(monthof(Date))) and (k=dayof(Date)) then
          (Form3.Components[i+3] as TFlatButton).Color:=clskyblue;
      k:=k+1;
    end;
    while i<40 do     //隐藏某月最后一天后的Label标签
    begin
      (Form3.Components[i+3] as TFlatButton).Visible:=false;
      i:=i+1;
    end;
   Form3.rl_fp7.Caption:=title_inf(iYear,imonth,dayof(date))+GetLunarHolDay(iyear,imonth,dayof(date))+'    '+Getjiejia(imonth,dayof(date))+' '+Getnonglijiejia(iyear,imonth,dayof(date));

end;
//====================================================================================================================

procedure TForm3.FormCreate(Sender: TObject);
var
  str:string;
begin 
  rl_fp6.Directory:=getCurrentDir+'\note';
//------------------------------------------------------------------------------
//滚动栏初始化部分
  rl_fp1.Caption:='隐藏日历>>';
  rl_fp5.Caption:='显示日记列表>>';
  rl_fp2.Height:=136;
  rl_fp6.Height:=0;
  rl_fp5.Top:=rl_fp2.Top+rl_fp2.Height;
//------------------------------------------------------------------------------
  self.choushi;
  rl_year.Text:=IntToStr(yearof(Date));    //获取重要的两个参数:年,月
  rl_month.Text:=IntToStr(monthof(Date));
  self.loadsunli(StrToInt(rl_year.Text),StrToInt(rl_month.Text));
  Form3.rl_fp7.Caption:='今天是:'+'  '+title_inf(yearof(date),monthof(date),dayof(date))+GetLunarHolDay(yearof(date),monthof(date),dayof(date))+' '+Getjiejia(monthof(date),dayof(date))+' '+Getnonglijiejia(yearof(date),monthof(date),dayof(date));

  browse(false,Encodedate(yearof(date),monthof(date),dayof(date)));  //初始化显示当天记录
  rl_fm_nt.Clear;      //当存在该日文件时,显示出来
  
  str:=datetimetostr(Encodedate(strtoint(rl_year.Text),strtoint(rl_month.Text),dayof(date)))+'.txt'; //显示几号的日记
  if FileExists(str)=true then
  rl_fm_nt.Lines.LoadFromFile(str);
  //为click_tag,enter_tag赋初值
  click_tag:=dayof(date);
  enter_tag:=dayof(date);
end;
//==============================================================================
//日历栏的滚动控制
procedure TForm3.rl_fp1Click(Sender: TObject);
begin
  if rl_fp1.Caption='隐藏日历>>' then
  begin
    rl_tm1.Enabled:=true;
    rl_fp1.Caption:='显示日历>>';
  end
  else
  begin
    rl_tm2.Enabled:=true;
    rl_fp1.Caption:='隐藏日历>>';
    rl_nt_delete.Visible:=false;
  end;
end;

procedure TForm3.rl_Tm1Timer(Sender: TObject);
begin
  rl_fp2.Height:=rl_fp2.Height-34;
  rl_fp5.Top:=rl_fp2.Top+rl_fp2.Height-2;
  if rl_fp2.Height<=0 then
  begin
   rl_Tm1.Enabled:=false;
  end;
end;

procedure TForm3.rl_tm2Timer(Sender: TObject);
begin
  rl_fp6.Height:=rl_fp6.Height-49;
  rl_fp5.Caption:='显示日记列表>>';
  rl_fp2.Height:=rl_fp2.Height+34;
  rl_fp5.Top:=rl_fp1.Top+rl_fp1.Height+rl_fp2.Height-1;
  if rl_fp2.Height>=136 then
  begin
    rl_tm2.Enabled:=false;
  end;
end;
//-------------------------------------------------------
//日程栏的滚动控制
procedure TForm3.rl_fp3Click(Sender: TObject);
begin
  if rl_fp3.Caption='显示日程>>' then
  begin
    rl_fp3.Caption:='隐藏日程>>';
    rl_tm3.Enabled:=true;
  end
  else
  begin
    rl_fp3.Caption:='显示日程>>';
    rl_tm4.Enabled:=true;
  end;
end;

procedure TForm3.rl_tm3Timer(Sender: TObject);
begin
  rl_fp4.Top:=rl_fp3.Top+rl_fp3.Height-2;
  rl_fp4.Height:=rl_fp4.Height+20;
  if rl_fm_nt.Height<>0 then
  rl_fm_nt.Height:=rl_fm_nt.Height-20;
  rl_fp_nt1.Top:=rl_fp4.Top+rl_fp4.Height;
  rl_fm_nt.Top:=rl_fp_nt1.Top+rl_fp_nt1.Height-1;
  if rl_fp4.Height>=80 then
  begin
   rl_Tm3.Enabled:=false;
  end;
end;

procedure TForm3.rl_tm4Timer(Sender: TObject);
begin
  rl_fp4.Height:=rl_fp4.Height-20;
  rl_fp_nt1.Top:=rl_fp4.Top+rl_fp4.Height-1;
  rl_fm_nt.Top:=rl_fp_nt1.Top+rl_fp_nt1.Height-1;
  if rl_fm_nt.Height<>0 then
  rl_fm_nt.Height:=rl_fm_nt.Height+20;
  if rl_fp4.Height<=0 then
  begin
   rl_Tm4.Enabled:=false;
  end;
end;
//-----------------------------------------------------------
//日记栏的滚动控制
procedure TForm3.rl_fp5Click(Sender: TObject);
begin
  if rl_fp5.Caption='显示日记列表>>' then
  begin
    rl_fp5.Caption:='隐藏日记列表>>';
    rl_tm5.Enabled:=true;
    rl_nt_delete.Visible:=true;
  end
  else
  begin
    rl_fp5.Caption:='显示日记列表>>';
    rl_tm6.Enabled:=true;
    rl_nt_delete.Visible:=false;
  end;
end;

procedure TForm3.rl_tm5Timer(Sender: TObject);
begin
  rl_fp1.Caption:='显示日历>>';
  rl_fp2.Height:=rl_fp2.Height-34;
  rl_fp5.Top:=rl_fp1.Top+rl_fp1.Height+rl_fp2.Height-3;
  rl_fp6.Top:=rl_fp5.Top+rl_fp5.Height-1;
  rl_fp6.Height:=rl_fp6.Height+49;
  if rl_fp6.Height>=196 then
  rl_tm5.Enabled:=false;
end;

procedure TForm3.rl_tm6Timer(Sender: TObject);
begin
  rl_fp6.Height:=rl_fp6.Height-47;
  if rl_fp6.Height<=0 then
  rl_tm6.Enabled:=false;
end;

procedure TForm3.rl_fp_nt1Click(Sender: TObject);
begin
  if rl_fp_nt1.Caption='隐藏日记内容>>' then
  begin
    rl_fp_nt1.Caption:='显示日记内容>>';
    rl_tm7.Enabled:=true;
    rl_nt_save.Visible:=false;
  end
  else
  begin
    rl_fp_nt1.Caption:='隐藏日记内容>>';
    rl_tm8.Enabled:=true;
    rl_nt_save.Visible:=true;
  end;
end;

procedure TForm3.rl_tm7Timer(Sender: TObject);
begin
  rl_fm_nt.Height:=rl_fm_nt.Height-39;
  if rl_fm_nt.Height<=0 then
  rl_tm7.Enabled:=false;
end;

procedure TForm3.rl_tm8Timer(Sender: TObject);
begin
  if rl_fp4.Height=0 then
  begin
  rl_fm_nt.Height:=rl_fm_nt.Height+39;
    if rl_fm_nt.Height>=195 then
    rl_tm8.Enabled:=false;
  end
  else if rl_fp4.Height=80 then
  begin
  rl_fm_nt.Height:=rl_fm_nt.Height+23;
    if rl_fm_nt.Height>=115 then
    rl_tm8.Enabled:=false;
  end;
end;
//==============================================================================

//单击下一月按钮
procedure TForm3.FlatButton46Click(Sender: TObject);
begin
if StrToInt(rl_month.Text)<=12 then
begin
  if (strToInt(rl_month.Text)=12) and (strToInt(rl_year.Text)<2050)then
  begin
  rl_month.Text:=IntToStr(1);
  rl_year.Text:=IntToStr(StrToInt(rl_year.Text)+1);
  end
  else if StrToInt(rl_month.Text)<12 then
  rl_month.Text:=IntToStr(StrToInt(rl_month.Text)+1);
  self.choushi;
  self.loadsunli(StrToInt(rl_year.Text),StrToInt(rl_month.Text));
  rl_year_month.Caption:=rl_year.Text+'年'+rl_month.Text+'月';
end;
end;
//单击上一月按钮
procedure TForm3.FlatButton45Click(Sender: TObject);
begin
if StrToInt(rl_month.Text)>=1 then
begin
  if (strToInt(rl_month.Text)=1) and (strToInt(rl_year.Text)>1901)then
  begin
  rl_month.Text:=IntToStr(12);
  rl_year.Text:=IntToStr(StrToInt(rl_year.Text)-1);
  end
  else if StrToInt(rl_month.Text)>1 then
  rl_month.Text:=IntToStr(StrToInt(rl_month.Text)-1);
  self.choushi;
  self.loadsunli(StrToInt(rl_year.Text),StrToInt(rl_month.Text));
  rl_year_month.Caption:=rl_year.Text+'年'+rl_month.Text+'月';
end;
end;
//单击下一年按钮
procedure TForm3.FlatButton47Click(Sender: TObject);
begin
if StrToInt(rl_year.Text)<2050 then
begin
rl_year.Text:=IntToStr(StrToInt(rl_year.Text)+1);
self.choushi;
self.loadsunli(StrToInt(rl_year.Text),StrToInt(rl_month.Text));
rl_year_month.Caption:=rl_year.Text+'年'+rl_month.Text+'月';
end;
end;
//单击上一年按钮
procedure TForm3.FlatButton44Click(Sender: TObject);
begin
if StrToInt(rl_year.Text)>1901 then
begin
rl_year.Text:=IntToStr(StrToInt(rl_year.Text)-1);
self.choushi;
self.loadsunli(StrToInt(rl_year.Text),StrToInt(rl_month.Text));
rl_year_month.Caption:=rl_year.Text+'年'+rl_month.Text+'月';
end;
end;

procedure TForm3.rl_year_monthClick(Sender: TObject);
var
  str:string;
begin
  rl_year.Text:=IntToStr(yearof(date));
  rl_month.Text:=IntToStr(monthof(date));
  rl_year_month.Caption:=rl_year.Text+'年'+rl_month.Text+'月';
  //----------------刷新日历--------------
  self.choushi;
  self.loadsunli(StrToInt(rl_year.Text),StrToInt(rl_month.Text));
  Form3.rl_fp7.Caption:='今天是:'+'  '+title_inf(yearof(date),monthof(date),dayof(date))+GetLunarHolDay(yearof(date),monthof(date),dayof(date))+' '+Getjiejia(monthof(date),dayof(date))+' '+Getnonglijiejia(yearof(date),monthof(date),dayof(date));
  //--------------------------------------
  str:=datetimetostr(Encodedate(strtoint(rl_year.Text),strtoint(rl_month.Text),dayof(date)))+'.txt'; //显示几号的日记
  if FileExists(str)=true then
  rl_fm_nt.Lines.LoadFromFile(str);
  browse(false,EncodeDate(StrToInt(Form3.rl_year.Text),StrToInt(Form3.rl_month.Text),dayof(date)));
end;

function show_add(index:word):boolean;  //显示窗体二,并初始化
begin
  enter:=1;  //判断是添加新记录窗体,还是修改更新窗体
  Form4.Caption:='添加新记录';
  Form4.rl_memo_txnr.Clear;
  Form4.rl_title.Clear;
  Form4.rl_dtp_date.Date:=EncodeDate(StrToInt(Form3.rl_year.Text),StrToInt(Form3.rl_month.Text),index);
  Form4.rl_dtp_time.Time:=time();
  Form4.ShowModal;
  result:=true;
end;

//------------------------------------------------------------------------------
procedure tForm3.FlatButtonclick(sender:Tobject);
var
  str:string;
  path_note:string;
begin
  Dbclick_count:=Dbclick_count+1;
  rl_tm_dbclick.Enabled:=true;
  click_tag:=Tcomponent(sender).Tag;
  Form3.rl_fp7.Caption:=title_inf(StrToInt(rl_Year.Text),StrToInt(rl_month.Text),click_tag)+GetLunarHolDay(StrToInt(rl_Year.Text),StrToInt(rl_month.Text),click_tag)+'    '+Getjiejia(StrToInt(rl_month.Text),click_tag)+' '+Getnonglijiejia(StrToInt(rl_Year.Text),StrToInt(rl_month.Text),click_tag);

  rl_fm_nt.Clear;      //当存在该日文件时,显示出来
  str:=datetimetostr(Encodedate(strtoint(rl_year.Text),strtoint(rl_month.Text),click_tag)); //显示几号的日记
  path_note:=str+'.txt';

  if FileExists(path_note)=true then
   rl_fm_nt.Lines.LoadFromFile(path_note);
  browse(false,EncodeDate(StrToInt(rl_year.Text),StrToInt(rl_month.Text),click_tag));      //显示该日的便签
  if dbclick_count>=2 then  //代替双击事件 
  begin
    dbclick_count:=0;
    show_add(click_tag);
  end;
end;

procedure tForm3.FlatButtonMouseEnter(Sender: TObject);
begin
  //到tag值
  enter_tag:=Tcomponent(sender).Tag;
end;


//------------------------------------------------------------------------------

function browse(browse_sign:boolean;browse_date:Tdate):boolean;  //浏览记录函数
var
  I: Integer;
  NewColumn: TListColumn;
  ListItem: TListItem;
  str:string;

  ts_info:file of info;
  infoRec:info;
  count:integer;
begin
  if check() then
begin
  AssignFile(ts_info,'wjt.wss');
  reset(ts_info);

⌨️ 快捷键说明

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