?? lsscalendar.pas
字號(hào):
i := 1;
while (i < length(S)) and (i < 6) do
begin
S1 := Copy(S,i,2);
{$IFDEF AAFONT}
if FSmoothText then
AAFont.TextOut(R.Left + 2, YY,S1)
else
{$ENDIF}
Canvas.TextOut(R.Left + 2, YY,S1);
yy := yy + H;
i := i + 2;
end;
end
else if FLunarCalStyle = csRight then
DrawString(S,R,DT_VCENTER OR DT_LEFT)
else
DrawString(S,R,DT_TOP OR DT_CENTER);
end;
procedure DrawFtvDay(R:TRect; TheDate:TDate);
var
S,S1:string;
H, yy, i, j:integer;
ch: char;
fcolor: TColor;
begin
S:= GetFtv(TheDate, fcolor);
if S = '' Then Exit;
if Length(S) > MaxFtvLen then
begin
//計(jì)算S包含的single-byte ASCII字符
j := 0;
for i := 1 to MaxFtvLen - 2 do
begin
ch := S[i];
if SizeOf(ch) = 1 then //multibyte
begin
if (Ord(ch) and $80) = 0 then Inc(j);
end;
end;
if j mod 2 > 0 then
S := Copy(S, 1, MaxFtvLen - 3)
else
S := Copy(S, 1, MaxFtvLen - 2);
S := S + '…';
end;
Canvas.Font := FCalColors.FtvTextFont;
if M <> MonthOf(FViewDate) then
Canvas.Font.Color := FCalColors.TrailingTextColor
else if fcolor > -1 then //說明:雖然在TFestivalList.Creat()中初始化為clRed,不知為什么GetFtv()返回的fcolor總是0。由于最近比較忙,沒有進(jìn)行深入分析這個(gè)bug。如果有哪位高手解決,請(qǐng)給我發(fā)一份wangzhijun2005@hotmail.com。
Canvas.Font.Color := fcolor;
if (FFtvCalStyle = csRight) and FShowVertical then
begin
H:= Canvas.TextHeight(S);
yy := R.Top + (R.Bottom - R.Top) div 3 - H;
i := 1;
while (i < length(S)) and (i < 6) do
begin
S1 := Copy(S,i,2);
{$IFDEF AAFONT}
if FSmoothText then
AAFont.TextOut(R.Left + 2, YY,S1)
else
{$ENDIF}
Canvas.TextOut(R.Left + 2, YY,S1);
yy := yy + H;
i := i + 2;
end;
end
else if FFtvCalStyle = csRight then
DrawString(S,R,DT_VCENTER OR DT_LEFT)
else
DrawString(S,R,DT_TOP OR DT_CENTER);
end;
begin {= TLssCalendar.Paint =}
inherited;
Canvas.Font.Assign(Font);
{$IFDEF AAFONT}
if FSmoothText then
begin
AAFont := TAAFontEx.Create(Canvas);
AAFont.Quality := aqHigh;
AAFont.Effect.Shadow.Enabled := FShadowFont;
end;
{$ENDIF}
try
with Canvas,FCalColors do
begin
// 畫年月
if RectVisible(Canvas.Handle,FTitleRect) then
begin
Brush.Color := TitleBackColor;
Brush.Style := bsSolid;
FillRect(FTitleRect);
Brush.Style := bsClear;
Font := TitleTextFont;
Gzdate := GetGz(FViewDate);
if FChineseEar then
begin
Outputstr := Cyclical(Gzdate.Year) + '(' + GetAnimal(GzDate.year) +
')年' + Cyclical(GzDate.Month) + '月';
end
else begin
if FEnWeekName then
OutputStr := MonthEnName(Month, True) + ' ' + InttoStr(Year)
else
OutputStr := FormatDateTime('yyyy年m月',FViewDate);
end;
DrawString(OutputStr,FTitleRect,DT_CENTER or DT_VCENTER);
if FShowArrow then
begin
Font.Color := ArrowColor;
Font.Size := Font.Size * 3 div 5;
DrawString('《',FPrevYearRect,DT_CENTER or DT_VCENTER);
DrawString('〈',FPrevMonthRect,DT_CENTER or DT_VCENTER);
DrawString('〉',FNextMonthRect,DT_CENTER or DT_VCENTER);
DrawString('》',FNextYearRect,DT_CENTER or DT_VCENTER);
end;
end;
//////////////////////////////////////
//畫星期
R := Bounds(FWeekRect.Left,FWeekRect.Top,FCellWidth,FCellHeight);
if RectVisible(Canvas.Handle, FWeekRect) then
begin
Brush.Color := WeekBackColor;
Brush.Style := bsSolid;
FillRect(FWeekRect);
Brush.Style := bsClear;
for i := 0 to 6 do
begin
aWeekDay := i;
if FUseISO8601 then Inc(aWeekDay);
Font := FWeekTextFont;
if (aWeekDay = 0) or (aWeekDay = 7) then //Sunday
Font.Color := FSundayColor
else if aWeekDay = 6 then //Saturday
Font.Color := FSaturdayColor;
if FEnWeekName then
OutputStr := WeekEnName(aWeekDay)
else
OutputStr := FormatWeekDay(aWeekDay);
drawstring(OutputStr,R,DT_CENTER or DT_VCENTER);
OffsetRect(R, FCellWidth , 0 );
end;
if not FShowGrid then
begin
Pen.Color := WeekTextFont.Color;
Pen.Width := 1;
Pen.Mode := pmCopy;
PenPos := Point(2,FWeekRect.Bottom - 2);
LineTo(FWeekRect.Right - 2 , FWeekRect.Bottom - 2);
end;
end;
//////////////////////////////////////
//畫背景
Brush.Color := Color;
Brush.Style := bsSolid;
FillRect(FDaysRect);
if FShowBackImage and (FBackImage <> nil) then
begin
StretchDraw(FDaysRect, FBackImage.Picture.Bitmap);
end;
Brush.Style := bsClear; //透明
if FShowBackMonth then
begin
Font := BackMonthTextFont;
OutputStr := FormatDateTime('m',FViewDate);
TextSize := TextExtent(OutputStr);
{$IFDEF AAFONT}
if FSmoothText then
AAFont.TextOut(FDaysRect.Left + (Width - TextSize.cx) div 2,
FDaysRect.Top + (FDaysRect.Bottom - FDaysRect.Top - TextSize.cy) div 2,OutputStr)
else
{$ENDIF}
Canvas.TextOut(FDaysRect.Left + (Width - TextSize.cx) div 2,
FDaysRect.Top + (FDaysRect.Bottom - FDaysRect.Top - TextSize.cy) div 2,OutputStr);
end;
if FShowBorder then
begin
Brush.Color := FCalColors.FBorderColor;
//Brush.Style := bsSolid;
FrameRect(ClientRect);
//Brush.Style := bsClear;
end;
if FShowGrid then
DrawGrid;
//////////////////////////////////////
//畫日期
R := Bounds(FDaysRect.Left, FDaysRect.Top , FCellWidth , FCellHeight);
for i := 0 to 41 do
begin
Col := i mod 7;
if FUseISO8601 then Inc(Col);
if RectVisible(Canvas.Handle, R) then
begin
TempDate := IncDay(FFirstDate, i);
DeCodeDate(TempDate,Y,M,D);
Font := DayTextFont;
if M = MonthOf(FViewDate) then
if (Col = 0) or (Col = 7) then
Font.Color := SundayColor
else
if col = 6 then
Font.Color := SaturdayColor
else
Font.Color := DayTextFont.Color
else
Font.Color := TrailingTextColor;
if GetMark(TempDate) > -1 then
begin
Brush.Style := bsSolid;
Brush.Color := GetMark(TempDate);
FillRect(R);
end;
if TempDate = FViewDate then //高亮顯示月歷日期
begin
Brush.Style := bsSolid;
Brush.Color := HightlightBackColor;
Font.Color := HightlightTextColor;
FillRect(R);
FOldRect := R;
DR := R;
InflateRect(DR,-2,-2);
//if Focused then Windows.DrawFocusRect(Handle,dR);
DrawFocusRect(DR);
//Brush.Style := bsClear;
end;
Brush.Style := bsClear;
if TempDate = DateOf(Now) then //在當(dāng)前日期畫一紅色框
begin
Pen.Color := ClRed;
Pen.Width := 1;
Rectangle(R.Left, R.Top, R.Right, R.Bottom );
end;
OutputStr := intToStr(D);
SR := FSolarRect;
OffsetRect(SR, R.Left, R.Top);
DrawString(OutputStr,SR,DT_VCENTER OR DT_CENTER);
if not IsRectEmpty(FFtvRect) and (FLunarCalStyle = FFtvCalStyle) then
begin
if GetFtv(TempDate) <> '' then
begin
FR := FFtvRect;
OffsetRect(FR, R.Left, R.Top);
DrawFtvDay(FR,TempDate);
end
else begin
DR := FLunarRect;
OffsetRect(DR, R.Left, R.Top);
DrawHzDay(DR,TempDate);
end;
end
else begin
if not IsRectEmpty(FLunarRect) then
begin
DR := FLunarRect;
OffsetRect(DR, R.Left, R.Top);
DrawHzDay(DR,TempDate);
end;
if not IsRectEmpty(FFtvRect) then
begin
FR := FFtvRect;
OffsetRect(FR, R.Left, R.Top);
DrawFtvDay(FR,TempDate);
end;
end;
end;
OffsetRect(R, 0, 0);
if (FUseISO8601 and (col = 7)) or (not FUseISO8601 and (col = 6)) then
OffsetRect(R, FDaysRect.Left - R.Left , FCellHeight)
else
OffsetRect(R,FCellWidth,0);
end; {end for}
end; {end with}
finally
{$IFDEF AAFONT}
if FSmoothText then AAFont.Free;
{$ENDIF}
end;
end; {= TLssCalendar.Paint =}
procedure TLssCalendar.Resize;
begin
inherited;
CalcRect;
end;
procedure TLssCalendar.CalcRect;
var
TextSize: TSize;
S: string;
w, h: integer;
begin
Canvas.Font.Assign(Font);
FCellWidth := ClientRect.Right div 7;
FCellHeight := ClientRect.Bottom div 8;
FTitleRect := ClientRect;
FTitleRect.Bottom := FCellHeight;
FWeekRect := Bounds(0, FTitleRect.Bottom, ClientRect.Right, FCellHeight);
FDaysRect := Bounds(0, FWeekRect.Bottom, ClientRect.Right, ClientRect.Bottom - FWeekRect.Bottom);
FSolarRect := Bounds(0, 0, FCellWidth, FCellHeight);
FLunarRect := Bounds(0, 0, 0, 0);
FFtvRect := Bounds(0, 0, 0, 0);
w := Round(FCellWidth / FHorizonScale);
h := Round(FCellHeight / FVerticalScale);
case FLunarCalStyle of
csNone:
case FFtvCalStyle of
csNone: ;
csRight:
begin
FSolarRect := Bounds(0, 0, FCellWidth - w, FCellHeight);
FFtvRect := Bounds(FSolarRect.Right, 0, w, FCellHeight);
end;
csBottom:
begin
FSolarRect := Bounds(0, 0, FCellWidth, FCellHeight - h);
FFtvRect := Bounds(0, FSolarRect.Bottom, FCellWidth, h);
end;
end;
csRight:
case FFtvCalStyle of
csNone:
begin
FSolarRect := Bounds(0, 0, FCellWidth - w, FCellHeight);
FLunarRect := Bounds(FSolarRect.Right, 0, w, FCellHeight);
end;
csRight:
begin
FSolarRect := Bounds(0, 0, FCellWidth - w, FCellHeight);
FLunarRect := Bounds(FSolarRect.Right, 0, w, FCellHeight);
FFtvRect := FLunarRect;
end;
csBottom:
begin
FSolarRect := Bounds(0, 0, FCellWidth - w, FCellHeight - h);
FLunarRect := Bounds(FSolarRect.Right, 0, w, FCellHeight - h);
FFtvRect := Bounds(0, FSolarRect.Bottom, FCellWidth, h);
end;
end;
csBottom:
case FFtvCalStyle of
csNone:
begin
FSolarRect := Bounds(0, 0, FCellWidth, FCellHeight - h);
FLunarRect := Bounds(0, FSolarRect.Bottom, FCellWidth, h);
end;
csRight:
begin
FSolarRect := Bounds(0, 0, FCellWidth - w, FCellHeight - h);
FLunarRect := Bounds(0, FSolarRect.Bottom, FCellWidth, h);
FFtvRect := Bounds(FSolarRect.Right, 0, w, FCellHeight - h);
end;
csBottom:
begin
FSolarRect := Bounds(0, 0, FCellWidth, FCellHeight - h);
FLunarRect := Bounds(0, FSolarRect.Bottom, FCellWidth, h);
FFtvRect := FLunarRect;
end;
end;
end;
with FCalColors do
begin
if FAutoFontSize then
begin
BackMonthTextFont.Size := GetMaxTextSize('9',FDaysRect.Right,Round((FDaysRect.Bottom - FDaysRect.Top) * 0.9));;
TitleTextFont.Size := GetMaxTextSize(FormatDateTime('yyyy年mm月',FViewDate),FTitleRect.Right,Round((FTitleRect.Bottom - FTitleRect.Top) * 0.8 ));
WeekTextFont.Size := GetMaxTextSize(FormatDateTime('ddd',FViewDate),Round(FCellWidth * 0.9),FCellHeight);
DayTextFont.Size := GetMaxTextSize(FormatDateTime('dd',FViewDate),FSolarRect.Right, FSolarRect.Bottom);
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -