jvcllaz: several changes in JvTimeFramework: Fix initially black background of TJvTFDays. Lighter default PrimeTime.Color. Some cleanup.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7104 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-08-08 21:01:04 +00:00
parent 8ae9d36333
commit 7794c04d51
5 changed files with 22 additions and 51 deletions

View File

@ -5,7 +5,7 @@ unit JvTimeFrameworkReg;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils, PropEdits;
procedure Register; procedure Register;
@ -27,18 +27,16 @@ begin
TJvTFUniversalPrinter, TJvTFDaysPrinter TJvTFUniversalPrinter, TJvTFDaysPrinter
]); ]);
// RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells, TJvTFMonths, 'Cells', nil); // register a nil property editor for now, so cells cannot be added,
// deleted, or moved at design time... BAD THINGS HAPPEN
RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells), TJvTFMonths, 'Cells', nil);
(* (*
// RegisterPropertyEditor(TypeInfo(string), TJvTFControl, 'Version', TutfVersionEditor); // RegisterPropertyEditor(TypeInfo(string), TJvTFControl, 'Version', TutfVersionEditor);
// RegisterPropertyEditor(TypeInfo(string), TJvTFScheduleManager, 'Version', TutfVersionEditor); // RegisterPropertyEditor(TypeInfo(string), TJvTFScheduleManager, 'Version', TutfVersionEditor);
RegisterComponents(RsPaletteTimeFramework, [TJvTFGlanceTextViewer, TJvTFMonths,
TJvTFWeeks, TJvTFAlarm]);
// RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells), '', 'Cells', // RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells), '', 'Cells',
// TJvTFGlanceCellsProperty); // TJvTFGlanceCellsProperty);
// register a nil property editor for now, so cells cannot be added,
// deleted, or moved at design time... BAD THINGS HAPPEN
RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells), TJvTFMonths, 'Cells', nil); RegisterPropertyEditor(TypeInfo(TJvTFGlanceCells), TJvTFMonths, 'Cells', nil);
RegisterComponents(RsPaletteTimeFramework, [TJvTFDays, TJvTFDaysPrinter]); RegisterComponents(RsPaletteTimeFramework, [TJvTFDays, TJvTFDaysPrinter]);
*) *)

View File

@ -1,7 +1,7 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 212 Left = 568
Height = 613 Height = 613
Top = 138 Top = 55
Width = 445 Width = 445
Caption = 'UTF Demo 1: PhotoOp' Caption = 'UTF Demo 1: PhotoOp'
ClientHeight = 613 ClientHeight = 613

View File

@ -33,7 +33,7 @@ interface
uses uses
LCLIntf, LCLIntf,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, sqldb, sqlite3conn, //DBTables, db, sqldb, sqlite3conn,
ComCtrls, StdCtrls, Buttons, ExtCtrls, ImgList, DateTimePicker, PrintersDlgs, ComCtrls, StdCtrls, Buttons, ExtCtrls, ImgList, DateTimePicker, PrintersDlgs,
JvTFManager, JvTFDays, JvTFGlance, JvTFGlanceTextViewer, JvTFMonths, JvTFManager, JvTFDays, JvTFGlance, JvTFGlanceTextViewer, JvTFMonths,
JvTFWeeks; JvTFWeeks;

View File

@ -1,7 +1,7 @@
object Share: TShare object Share: TShare
Left = 738 Left = 672
Height = 216 Height = 216
Top = 285 Top = 110
Width = 271 Width = 271
AutoSize = True AutoSize = True
Caption = 'Share' Caption = 'Share'
@ -9,8 +9,6 @@ object Share: TShare
ClientWidth = 271 ClientWidth = 271
Color = clBtnFace Color = clBtnFace
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
OnClose = FormClose OnClose = FormClose
OnShow = FormShow OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter

View File

@ -69,6 +69,8 @@ const
gcGroupHdr = -2; gcGroupHdr = -2;
gcHdr = -1; gcHdr = -1;
DEFAULT_PRIMETIME_COLOR = $00C4FFFF;
type type
EJvTFDaysError = class(Exception); EJvTFDaysError = class(Exception);
@ -205,7 +207,7 @@ type
published published
property StartTime: TTime read FStartTime write SetStartTime; property StartTime: TTime read FStartTime write SetStartTime;
property EndTime: TTime read FEndTime write SetEndTime; property EndTime: TTime read FEndTime write SetEndTime;
property Color: TColor read FColor write SetColor; property Color: TColor read FColor write SetColor default DEFAULT_PRIMETIME_COLOR;
end; end;
TJvTFCreateQuickEntryEvent = procedure(Sender: TObject; var ApptID: string; TJvTFCreateQuickEntryEvent = procedure(Sender: TObject; var ApptID: string;
@ -1278,7 +1280,7 @@ type
function GetApptDispColor(Appt: TJvTFAppt; Selected: Boolean): TColor; function GetApptDispColor(Appt: TJvTFAppt; Selected: Boolean): TColor;
published published
property DitheredBackground: Boolean read FDitheredBackground write SetDitheredBackground default True; property DitheredBackground: Boolean read FDitheredBackground write SetDitheredBackground default false;
// property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; // property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
// grid layout properties // grid layout properties
property AutoSizeCols: Boolean read FAutoSizeCols write SetAutoSizeCols default True; property AutoSizeCols: Boolean read FAutoSizeCols write SetAutoSizeCols default True;
@ -1746,6 +1748,7 @@ type
implementation implementation
uses uses
FPCanvas,
JvResources; JvResources;
//Type //Type
@ -2181,7 +2184,7 @@ begin
FApptGrid := AApptGrid; FApptGrid := AApptGrid;
FStartTime := EncodeTime(8, 0, 0, 0); FStartTime := EncodeTime(8, 0, 0, 0);
FEndTime := EncodeTime(17, 0, 0, 0); FEndTime := EncodeTime(17, 0, 0, 0);
FColor := clYellow; FColor := DEFAULT_PRIMETIME_COLOR;
FFillPic := TBitmap.Create; FFillPic := TBitmap.Create;
FFillPic.Width := 16; FFillPic.Width := 16;
FFillPic.Height := 16; FFillPic.Height := 16;
@ -4090,7 +4093,7 @@ begin
FFocusedCol := -1; FFocusedCol := -1;
FFocusedRow := -1; FFocusedRow := -1;
FGridLineColor := clGray; FGridLineColor := clGray;
FDitheredBackground := True; FDitheredBackground := false;
{$IFDEF Jv_TIMEBLOCKS} {$IFDEF Jv_TIMEBLOCKS}
// all ok // all ok
@ -4869,6 +4872,7 @@ end;
procedure TJvTFDays.Paint; procedure TJvTFDays.Paint;
var var
I, J, lRightCol, lBottomRow: Integer; I, J, lRightCol, lBottomRow: Integer;
w, h: Integer;
begin begin
{ optimization incorrectly kicks in if control is only partially { optimization incorrectly kicks in if control is only partially
visible on the screen visible on the screen
@ -4887,16 +4891,17 @@ begin
end; end;
} }
w := ClientWidth;
h := ClientHeight;
with PaintBuffer do with PaintBuffer do
begin begin
Width := ClientWidth; SetSize(w, h);
Height := ClientHeight;
with Canvas do with Canvas do
begin begin
Pixels[0, 0] := clWhite; // Workaround for Lazarus to avoid black background
if FDitheredBackground then if FDitheredBackground then
// added by TIM, 10/27/2001 10:36:03 PM: // added by TIM, 10/27/2001 10:36:03 PM:
DrawDither(Canvas, Classes.Rect(0, 0, Width, Height), Self.Color, clGray) DrawDither(Canvas, Classes.Rect(0, 0, w, h), Self.Color, clGray)
else else
begin begin
Brush.Color := Self.Color; Brush.Color := Self.Color;
@ -4905,10 +4910,8 @@ begin
end; end;
DrawCorner(Canvas, agcTopLeft); DrawCorner(Canvas, agcTopLeft);
if Cols.Count = 0 then if Cols.Count = 0 then
DrawEmptyColHdr(Canvas); DrawEmptyColHdr(Canvas);
DrawGroupHdrs(Canvas); DrawGroupHdrs(Canvas);
lRightCol := LeftCol + VisibleCols - 1; lRightCol := LeftCol + VisibleCols - 1;
@ -10492,14 +10495,10 @@ procedure TJvTFDays.DrawDither(ACanvas: TCanvas; ARect: TRect;
var var
DitherBitmap: TBitmap; DitherBitmap: TBitmap;
I, J: Integer; I, J: Integer;
// TL: TPoint;
// ClipRgn: HRgn;
begin begin
DitherBitmap := TBitmap.Create; DitherBitmap := TBitmap.Create;
try try
// create dithered bitmap // create dithered bitmap
// DitherBitmap.Width := RectWidth(ARect);
// DitherBitmap.Height := RectHeight(ARect);
DitherBitmap.Width := 8; DitherBitmap.Width := 8;
DitherBitmap.Height := 8; DitherBitmap.Height := 8;
for I := 0 to DitherBitmap.Width - 1 do for I := 0 to DitherBitmap.Width - 1 do
@ -10509,32 +10508,8 @@ begin
else else
DitherBitmap.Canvas.Pixels[I, J] := Color2; DitherBitmap.Canvas.Pixels[I, J] := Color2;
// copy bitmap into canvas
// ClipRgn := Windows.CreateRectRgn(ARect.Left, ARect.Top, ARect.Right + 1, ARect.Bottom + 1);
// try
// Windows.SelectClipRgn(ACanvas.Handle, ClipRgn);
// TL.X := ARect.Left;
// while (TL.X <= ARect.Right) do
// begin
// TL.Y := ARect.Top;
// while (TL.Y <= ARect.Bottom) do
// begin
// Windows.BitBlt(ACanvas.Handle, TL.X, TL.Y, DitherBitmap.Width, DitherBitmap.Height,
// DitherBitmap.Canvas.Handle, 0, 0, SRCCOPY);
// TL.Y := TL.Y + DitherBitmap.Height;
// end;
// TL.X := TL.X + DitherBitmap.Width;
// end;
// finally
// Windows.SelectClipRgn(ACanvas.Handle, 0);
// Windows.DeleteObject(ClipRgn);
// end;
ACanvas.Brush.Bitmap := DitherBitmap; ACanvas.Brush.Bitmap := DitherBitmap;
ACanvas.FillRect(ARect); ACanvas.FillRect(ARect);
// Windows.BitBlt(ACanvas.Handle, ARect.Left, ARect.Top, DitherBitmap.Width, DitherBitmap.Height,
// DitherBitmap.Canvas.Handle, 0, 0, SRCCOPY);
finally finally
DitherBitmap.Free; DitherBitmap.Free;
end; end;