pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Less hints and warnings.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4940 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-07-12 09:26:14 +00:00
parent 4bd27ec6db
commit 6517dc0e2e
16 changed files with 100 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
components/tvplanit/source/vpabout.pas
View File

@ -34,7 +34,7 @@ interface
uses uses
{$IFDEF LCL} {$IFDEF LCL}
LMessages, LCLProc, LCLType, LCLIntf, LCLProc, LCLType, LCLIntf,
{$ELSE} {$ELSE}
Windows, Messages, Windows, Messages,
{$ENDIF} {$ENDIF}
@ -71,10 +71,8 @@ type
Label3: TLabel; Label3: TLabel;
Label1: TLabel; Label1: TLabel;
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure lblLinkMouseMove(Sender: TObject; Shift: TShiftState; X, procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
Y: Integer); procedure lblLinkMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lblLinkClick(Sender: TObject); procedure lblLinkClick(Sender: TObject);
private private
{ Private declarations } { Private declarations }
@ -103,7 +101,7 @@ uses
{$IFNDEF LCL} {$IFNDEF LCL}
ShellAPI, ShellAPI,
{$ENDIF} {$ENDIF}
VpConst, VpSR; VpConst, VpMisc, VpSR;
const const
TURBO_LINK_URL = 'http://sourceforge.net/projects/tpvplanit/'; TURBO_LINK_URL = 'http://sourceforge.net/projects/tpvplanit/';
@ -156,6 +154,7 @@ end;
procedure TfrmAbout.FormMouseMove(Sender: TObject; Shift: TShiftState; procedure TfrmAbout.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
begin begin
Unused(Shift, X, Y);
lblTurboLink.Font.Style := []; lblTurboLink.Font.Style := [];
end; end;
@ -180,6 +179,7 @@ end;
procedure TfrmAbout.lblLinkMouseMove(Sender: TObject; procedure TfrmAbout.lblLinkMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
begin begin
Unused(Shift, X, Y);
TLabel(Sender).Font.Style := [fsUnderline]; TLabel(Sender).Font.Style := [fsUnderline];
end; end;

8
components/tvplanit/source/vpbase.pas
View File

@ -358,12 +358,10 @@ implementation
{$R vpbase.res} {$R vpbase.res}
{$IFNDEF LCL}
uses uses
Math CommCtrl;
{$IFNDEF LCL} {$ENDIF}
, CommCtrl
{$ENDIF}
;
{ EAdStreamError } { EAdStreamError }

4
components/tvplanit/source/vpbufds.pas
View File

@ -65,7 +65,7 @@ implementation
uses uses
LazFileUtils, LazFileUtils,
VpConst, VpBaseDS, VpData; VpConst, VpMisc, VpBaseDS, VpData;
const const
TABLE_EXT = '.db'; TABLE_EXT = '.db';
@ -166,6 +166,7 @@ end;
function TVpBufDSDatastore.GetNextID(TableName: string): Integer; function TVpBufDSDatastore.GetNextID(TableName: string): Integer;
begin begin
Unused(TableName);
if FUseAutoInc then if FUseAutoInc then
{ This is not needed in the BufDataset datastore as these tables use { This is not needed in the BufDataset datastore as these tables use
autoincrement fields. } autoincrement fields. }
@ -243,7 +244,6 @@ end;
procedure TVpBufDSDatastore.SetUseAutoInc(AValue: Boolean); procedure TVpBufDSDatastore.SetUseAutoInc(AValue: Boolean);
var var
dir: String; dir: String;
table: TBufDataset;
begin begin
if AValue = FUseAutoInc then if AValue = FUseAutoInc then
exit; exit;

4
components/tvplanit/source/vpcalendar.pas
View File

@ -344,7 +344,7 @@ type
implementation implementation
uses uses
VpData, VpCalendarPainter; VpCalendarPainter;
const const
calMargin = 4; {left, right, and top margin} calMargin = 4; {left, right, and top margin}
@ -862,8 +862,10 @@ end;
{=====} {=====}
procedure TVpCustomCalendar.CreateParams(var Params: TCreateParams); procedure TVpCustomCalendar.CreateParams(var Params: TCreateParams);
{$IFNDEF LCL}
const const
BorderStyles: array[TBorderStyle] of LongInt = (0, WS_BORDER); BorderStyles: array[TBorderStyle] of LongInt = (0, WS_BORDER);
{$ENDIF}
begin begin
inherited CreateParams(Params); inherited CreateParams(Params);
{$IFNDEF LCL} {$IFNDEF LCL}

4
components/tvplanit/source/vpdata.pas
View File

@ -39,9 +39,9 @@ uses
{$ELSE} {$ELSE}
Windows, Windows,
{$ENDIF} {$ENDIF}
SysUtils, Classes, SysUtils, Classes, Dialogs,
{$IFDEF VERSION6} Types, {$ENDIF} {$IFDEF VERSION6} Types, {$ENDIF}
VpBase, VpSR, VpConst, Dialogs; VpSR;
type type
TVpEventRec = packed record TVpEventRec = packed record

10
components/tvplanit/source/vpdateedit.pas
View File

@ -220,13 +220,15 @@ begin
{get the date order from windows} {get the date order from windows}
C[0] := '0'; {default} C[0] := '0'; {default}
//TODO: //TODO:
{$IFNDEF LCL} {$IFDEF DELPHI}
GetProfileString('intl', 'iDate', '0', C, 2); GetProfileString('intl', 'iDate', '0', C, 2);
{$ENDIF}
DateOrder := TVpDateOrder(Ord(C[0])-Ord('0'));
{load button glyph} {load button glyph}
FButton.Glyph.Handle := LoadBaseBitmap('VPBTNCAL'); FButton.Glyph.Handle := LoadBaseBitmap('VPBTNCAL');
{$ELSE}
DateOrder := TVpDateOrder(Ord(C[0])-Ord('0'));
{load button glyph}
FButton.Glyph.LoadFromResourceName(HINSTANCE,'VPBTNCAL');
{$ENDIF}
{create color class} {create color class}
FPopupCalColors := TVpCalColors.Create; FPopupCalColors := TVpCalColors.Create;

10
components/tvplanit/source/vpdayview.pas
View File

@ -70,7 +70,7 @@ uses
{$ELSE} {$ELSE}
Windows, Messages, Windows, Messages,
{$ENDIF} {$ENDIF}
Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, Classes, Graphics, Controls, ExtCtrls, StdCtrls,
Buttons, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, Buttons, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst,
VpCanvasUtils, Menus; VpCanvasUtils, Menus;
@ -122,9 +122,9 @@ type
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override;
{$IFNDEF LCL} {$IFNDEF LCL}
procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS; procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
{$ELSE} {$ELSE}
procedure WMKillFocus(var Msg : TLMKillFocus); message LM_KILLFOCUS; procedure WMKillFocus(var Msg: TLMKillFocus); message LM_KILLFOCUS;
{$ENDIF} {$ENDIF}
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -546,6 +546,7 @@ procedure TVpDvInPlaceEdit.WMKillFocus(var Msg: TWMKillFocus);
procedure TVpDvInPlaceEdit.WMKillFocus(var Msg: TLMKillFocus); procedure TVpDvInPlaceEdit.WMKillFocus(var Msg: TLMKillFocus);
{$ENDIF} {$ENDIF}
begin begin
Unused(Msg);
TVpDayView(Owner).EndEdit(self); TVpDayView(Owner).EndEdit(self);
end; end;
{=====} {=====}
@ -1801,6 +1802,7 @@ procedure TVpDayView.WMSetFocus(var Msg: TWMSetFocus);
procedure TVpDayView.WMSetFocus(var Msg: TLMSetFocus); procedure TVpDayView.WMSetFocus(var Msg: TLMSetFocus);
{$ENDIF} {$ENDIF}
begin begin
Unused(Msg);
if ActiveRow = -1 then ActiveRow := TopLine; if ActiveRow = -1 then ActiveRow := TopLine;
end; end;
{=====} {=====}
@ -2264,6 +2266,8 @@ end;
{.$IFNDEF LCL} {.$IFNDEF LCL}
procedure TVpDayView.VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); procedure TVpDayView.VpDayViewInit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF});
begin begin
Unused(Msg);
if csLoading in ComponentState then begin if csLoading in ComponentState then begin
PostMessage(Handle, Vp_DayViewInit, 0, 0); PostMessage(Handle, Vp_DayViewInit, 0, 0);
Exit; Exit;

10
components/tvplanit/source/vpdbds.pas
View File

@ -58,9 +58,8 @@ type
{ property setters } { property setters }
procedure SetReadOnly(const Value: boolean); procedure SetReadOnly(const Value: boolean);
procedure SetFilterCriteria(aTable : TDataset; aUseDateTime : Boolean; procedure SetFilterCriteria(aTable: TDataset; aUseDateTime: Boolean;
aResourceID : Integer; aStartDateTime : TDateTime; aResourceID: Integer; aStartDateTime, aEndDateTime: TDateTime); virtual;
aEndDateTime : TDateTime); virtual;
protected {properties that may be surfaced later} protected {properties that may be surfaced later}
property ReadOnly : boolean property ReadOnly : boolean
@ -1943,9 +1942,8 @@ begin
end; end;
{=====} {=====}
procedure TVpCustomDBDataStore.SetFilterCriteria(aTable : TDataset; procedure TVpCustomDBDataStore.SetFilterCriteria(aTable: TDataset;
aUseDateTime : Boolean; aResourceID : Integer; aStartDateTime : TDateTime; aUseDateTime: Boolean; aResourceID: Integer; aStartDateTime, aEndDateTime: TDateTime);
aEndDateTime : TDateTime);
begin begin
// error here: "... raised an exception class 'EDatabaseError' with message: // error here: "... raised an exception class 'EDatabaseError' with message:
// Index based on unknown field '>='.". // Index based on unknown field '>='.".

7
components/tvplanit/source/vpedshape.pas
View File

@ -302,7 +302,6 @@ const
var var
w: Integer; w: Integer;
cnv: TControlCanvas; cnv: TControlCanvas;
d: Integer;
shape: TVpShapeType; shape: TVpShapeType;
begin begin
w := MaxValue([GetLabelWidth(lblPenColor), GetLabelWidth(lblPenStyle), w := MaxValue([GetLabelWidth(lblPenColor), GetLabelWidth(lblPenStyle),
@ -389,8 +388,6 @@ begin
end; end;
procedure TfrmEditShape.SetData(AShape: TVpPrintShape); procedure TfrmEditShape.SetData(AShape: TVpPrintShape);
var
StyleStr : string;
begin begin
FShapeButtons[AShape.Shape].Down := true; FShapeButtons[AShape.Shape].Down := true;
@ -417,6 +414,8 @@ var
R: TRect; R: TRect;
bs: TBrushStyle; bs: TBrushStyle;
begin begin
Unused(Control, State);
Item := cbBrushStyle.Items[Index]; Item := cbBrushStyle.Items[Index];
x := Rect.Left + HeightOf(Rect); x := Rect.Left + HeightOf(Rect);
with cbBrushStyle.Canvas do with cbBrushStyle.Canvas do
@ -483,6 +482,8 @@ var
TxtRect : TRect; TxtRect : TRect;
x, y: Integer; x, y: Integer;
begin begin
Unused(Control, State);
Item := cbPenStyle.Items[Index]; Item := cbPenStyle.Items[Index];
x := Rect.Left + HeightOf(Rect) * 2; x := Rect.Left + HeightOf(Rect) * 2;
y := Rect.Top + HeightOf(Rect) div 2; y := Rect.Top + HeightOf(Rect) div 2;

5
components/tvplanit/source/vpinids.pas
View File

@ -25,7 +25,7 @@ type
procedure StrToContact(AString: String; AContact: TVpContact); procedure StrToContact(AString: String; AContact: TVpContact);
procedure StrToEvent(AString: String; AEvent: TVpEvent); procedure StrToEvent(AString: String; AEvent: TVpEvent);
procedure StrToEventTimes(AString: String; var AStartTime, AEndTime: TDateTime); procedure StrToEventTimes(AString: String; out AStartTime, AEndTime: TDateTime);
procedure StrToResource(AString: String; AResource: TVpResource); procedure StrToResource(AString: String; AResource: TVpResource);
procedure StrToTask(AString: String; ATask: TVpTask); procedure StrToTask(AString: String; ATask: TVpTask);
@ -168,6 +168,7 @@ end;
function TVpIniDatastore.GetNextID(TableName: string): Integer; function TVpIniDatastore.GetNextID(TableName: string): Integer;
begin begin
Unused(TableName);
repeat repeat
Result := Random(High(Integer)); Result := Random(High(Integer));
until UniqueID(Result) and (Result <> -1); until UniqueID(Result) and (Result <> -1);
@ -449,7 +450,7 @@ begin
end; end;
procedure TVpIniDatastore.StrToEventTimes(AString: String; procedure TVpIniDatastore.StrToEventTimes(AString: String;
var AStartTime, AEndTime: TDateTime); out AStartTime, AEndTime: TDateTime);
var var
L: TStrings; L: TStrings;
begin begin

28
components/tvplanit/source/vpmisc.pas
View File

@ -75,17 +75,22 @@ function AssembleName(Contact: TVpContact): string;
procedure ParseName(Contact: TVpContact; const Value: string); procedure ParseName(Contact: TVpContact; const Value: string);
{ parses the name into it's elements and updates the contact } { parses the name into it's elements and updates the contact }
procedure ParseCSZ(Str: string; var City, State, Zip: string); procedure ParseCSZ(Str: string; var City, State, Zip: string);
{ parses the string and returns the city, state and zip parameters } { parses the string and returns the city, state and zip parameters }
{$IFDEF DELPHI}
function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP; function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
{-load and return the handle to bitmap resource} {-load and return the handle to bitmap resource}
function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR; function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
{-load and return the handle to cursor resource} {-load and return the handle to cursor resource}
{$ENDIF}
function HeightOf(const R : TRect) : Integer; function HeightOf(const R : TRect) : Integer;
{- return the height of the TRect} {- return the height of the TRect}
function WidthOf(const R : TRect) : Integer; function WidthOf(const R : TRect) : Integer;
{- return the width of the TRect} {- return the width of the TRect}
function RightOf(AControl: TControl): Integer; function RightOf(AControl: TControl): Integer;
{- returns the right edge of a control } {- returns the right edge of a control }
function GetDisplayString(Canvas : TCanvas; const S : string; function GetDisplayString(Canvas : TCanvas; const S : string;
MinChars, MaxWidth : Integer) : string; MinChars, MaxWidth : Integer) : string;
{-given a string, a minimum number of chars to display, and a max width, } {-given a string, a minimum number of chars to display, and a max width, }
@ -131,6 +136,9 @@ function GetRealFontHeight(AFont: TFont): Integer;
function DecodeLineEndings(const AText: String): String; function DecodeLineEndings(const AText: String): String;
function EncodeLineEndings(const AText: String): String; function EncodeLineEndings(const AText: String): String;
procedure Unused(const A1); overload;
procedure Unused(const A1, A2); overload;
procedure Unused(const A1, A2, A3); overload;
implementation implementation
@ -227,6 +235,7 @@ begin
end; end;
{=====} {=====}
{$IFDEF DELPHI}
function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP; function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
begin begin
{$IFDEF FPC} {$IFDEF FPC}
@ -241,6 +250,7 @@ function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
begin begin
//TODO: Result := LoadCursor(FindClassHInstance(TVpCustomControl), lpCursorName); //TODO: Result := LoadCursor(FindClassHInstance(TVpCustomControl), lpCursorName);
end; end;
{$ENDIF}
function WidthOf(const R : TRect) : Integer; function WidthOf(const R : TRect) : Integer;
begin begin
@ -623,4 +633,18 @@ begin
Result := StringReplace(AText, LineEnding, '\n', [rfReplaceAll]); Result := StringReplace(AText, LineEnding, '\n', [rfReplaceAll]);
end; end;
{$PUSH}{$HINTS OFF}
procedure Unused(const A1);
begin
end;
procedure Unused(const A1, A2);
begin
end;
procedure Unused(const A1, A2, A3);
begin
end;
{$POP}
end. end.

13
components/tvplanit/source/vpmonthview.pas
View File

@ -38,7 +38,7 @@ uses
{$ELSE} {$ELSE}
Windows, Messages, Windows, Messages,
{$ENDIF} {$ENDIF}
Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, Classes, Graphics, Controls, ComCtrls, ExtCtrls,
VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus; VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus;
type type
@ -181,8 +181,8 @@ type
message CM_WANTSPECIALKEY; message CM_WANTSPECIALKEY;
{$ELSE} {$ELSE}
procedure WMSize(var Msg: TLMSize); message LM_SIZE; procedure WMSize(var Msg: TLMSize); message LM_SIZE;
procedure WMSetFocus(var Msg : TLMSetFocus); message LM_SETFOCUS; procedure WMSetFocus(var Msg: TLMSetFocus); message LM_SETFOCUS;
procedure WMRButtonDown(var Msg : TLMRButtonDown); message LM_RBUTTONDOWN; procedure WMRButtonDown(var Msg: TLMRButtonDown); message LM_RBUTTONDOWN;
{$ENDIF} {$ENDIF}
procedure PopupToday (Sender : TObject); procedure PopupToday (Sender : TObject);
procedure PopupNextMonth (Sender : TObject); procedure PopupNextMonth (Sender : TObject);
@ -268,7 +268,7 @@ type
implementation implementation
uses uses
SysUtils, Math, LazUTF8, Forms, Dialogs, VpEvntEditDlg, VpMonthViewPainter; SysUtils, LazUTF8, Forms, Dialogs, VpMonthViewPainter;
(*****************************************************************************) (*****************************************************************************)
{ TVpContactHeadAttr } { TVpContactHeadAttr }
@ -746,11 +746,12 @@ end;
{=====} {=====}
{$IFNDEF LCL} {$IFNDEF LCL}
procedure TVpMonthView.WMSetFocus(var Msg : TWMSetFocus); procedure TVpMonthView.WMSetFocus(var Msg: TWMSetFocus);
{$ELSE} {$ELSE}
procedure TVpMonthView.WMSetFocus(var Msg : TLMSetFocus); procedure TVpMonthView.WMSetFocus(var Msg: TLMSetFocus);
{$ENDIF} {$ENDIF}
begin begin
Unused(Msg);
// if active event is nil then set active event to the first diaplsyed one. // if active event is nil then set active event to the first diaplsyed one.
end; end;
{=====} {=====}

3
components/tvplanit/source/vpsqlite3ds.pas
View File

@ -63,7 +63,7 @@ implementation
uses uses
LazFileUtils, LazFileUtils,
VpConst; VpConst, VpMisc;
{ TVpZeosDatastore } { TVpZeosDatastore }
@ -279,6 +279,7 @@ end;
function TVpSqlite3DataStore.GetNextID(TableName: string): integer; function TVpSqlite3DataStore.GetNextID(TableName: string): integer;
begin begin
Unused(TableName);
{ This is not needed in the SQLITE3 datastore as these tables use { This is not needed in the SQLITE3 datastore as these tables use
autoincrement fields. } autoincrement fields. }
Result := -1; Result := -1;

2
components/tvplanit/source/vpweekview.pas
View File

@ -264,7 +264,7 @@ type
implementation implementation
uses uses
SysUtils, Math, LazUTF8, Forms, Dialogs, VpEvntEditDlg, VpWeekViewPainter; SysUtils, LazUTF8, Forms, Dialogs, VpEvntEditDlg, VpWeekViewPainter;
(*****************************************************************************) (*****************************************************************************)
{ TVpTGInPlaceEdit } { TVpTGInPlaceEdit }

10
components/tvplanit/source/vpweekviewpainter.pas
View File

@ -39,7 +39,7 @@ type
procedure DrawDay(ADayIndex: Integer; var DayRect: TRect; var EAIndex: Integer); procedure DrawDay(ADayIndex: Integer; var DayRect: TRect; var EAIndex: Integer);
procedure DrawDayHeader(ADayIndex: Integer; var TextRect: TRect); procedure DrawDayHeader(ADayIndex: Integer; var TextRect: TRect);
procedure DrawDays; procedure DrawDays;
procedure DrawEvent(AEvent: TVpEvent; DayRect, TextRect: TRect; ADayIndex: Integer); procedure DrawEvent(AEvent: TVpEvent; TextRect: TRect; ADayIndex: Integer);
procedure DrawHeader; procedure DrawHeader;
procedure FixFontHeights; procedure FixFontHeights;
procedure InitColors; procedure InitColors;
@ -226,8 +226,6 @@ begin
end; end;
procedure TVpWeekViewPainter.DrawBorders; procedure TVpWeekViewPainter.DrawBorders;
var
shadow, bright: TColor;
begin begin
if FWeekView.DrawingStyle = dsFlat then begin if FWeekView.DrawingStyle = dsFlat then begin
{ {
@ -281,7 +279,6 @@ var
rowHeight: Integer; rowHeight: Integer;
headerHeight: Integer; headerHeight: Integer;
tmpRect: TRect; tmpRect: TRect;
event: TVpEvent;
begin begin
// Abbreviations // Abbreviations
dayHeadHeight := TVpWeekviewOpener(FWeekView).wvDayHeadHeight; dayHeadHeight := TVpWeekviewOpener(FWeekView).wvDayHeadHeight;
@ -349,7 +346,7 @@ begin
end; end;
// Write the event text // Write the event text
DrawEvent(TVpEvent(EventList.List^[J]), DayRect, TextRect, ADayIndex); DrawEvent(TVpEvent(EventList.List^[J]), TextRect, ADayIndex);
// Update the EventArray // Update the EventArray
with TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex] do begin with TVpWeekViewOpener(FWeekView).wvEventArray[EAIndex] do begin
@ -482,10 +479,9 @@ begin
TPSLineTo(RenderCanvas, Angle, RenderIn, realCenter, RealBottom - 1); TPSLineTo(RenderCanvas, Angle, RenderIn, realCenter, RealBottom - 1);
end; end;
procedure TVpWeekViewPainter.DrawEvent(AEvent: TVpEvent; DayRect, TextRect: TRect; procedure TVpWeekViewPainter.DrawEvent(AEvent: TVpEvent; TextRect: TRect;
ADayIndex: Integer); ADayIndex: Integer);
var var
tmpRect: TRect;
dayStr: String; dayStr: String;
todayStartTime: TDateTime; todayStartTime: TDateTime;
todayEndTime: TDateTime; todayEndTime: TDateTime;

45
components/tvplanit/source/vpxmlds.pas
View File

@ -13,7 +13,6 @@ uses
type type
TVpXmlDatastore = class(TVpCustomDatastore) TVpXmlDatastore = class(TVpCustomDatastore)
private private
FDoc: TXmlDocument;
FFilename: String; FFilename: String;
FParentNode: String; FParentNode: String;
FXmlSettings: TFormatSettings; FXmlSettings: TFormatSettings;
@ -30,13 +29,13 @@ type
function FindStoreNode(ADoc: TDOMDocument): TDOMNode; function FindStoreNode(ADoc: TDOMDocument): TDOMNode;
procedure ReadContact(ANode: TDOMNode; AContacts: TVpContacts); procedure ReadContact(ANode: TDOMNode; AContacts: TVpContacts);
procedure ReadContacts(ADoc: TDOMDocument; ANode: TDOMNode; AContacts: TVpContacts); procedure ReadContacts(ANode: TDOMNode; AContacts: TVpContacts);
procedure ReadEvent(ANode: TDOMNode; ASchedule: TVpSchedule); procedure ReadEvent(ANode: TDOMNode; ASchedule: TVpSchedule);
procedure ReadEvents(ADoc: TDOMDocument; ANode: TDOMNode; ASchedule: TVpSchedule); procedure ReadEvents(ANode: TDOMNode; ASchedule: TVpSchedule);
procedure ReadResource(ADoc: TDOMDocument; ANode: TDOMNode); procedure ReadResource(ANode: TDOMNode);
procedure ReadResources(ADoc: TDOMDocument; ANode: TDOMNode); procedure ReadResources(ANode: TDOMNode);
procedure ReadTask(ANode: TDOMNode; ATasks: TVpTasks); procedure ReadTask(ANode: TDOMNode; ATasks: TVpTasks);
procedure ReadTasks(ADoc: TDOMDocument; ANode: TDOMNode; ATasks: TVpTasks); procedure ReadTasks(ANode: TDOMNode; ATasks: TVpTasks);
procedure WriteContact(ADoc: TDOMDocument; AContactNode: TDOMNode; AContact: TVpContact); procedure WriteContact(ADoc: TDOMDocument; AContactNode: TDOMNode; AContact: TVpContact);
procedure WriteContacts(ADoc: TDOMDocument; AParentNode: TDOMNode; AResource: TVpResource); procedure WriteContacts(ADoc: TDOMDocument; AParentNode: TDOMNode; AResource: TVpResource);
@ -74,7 +73,7 @@ type
implementation implementation
uses uses
typinfo, StrUtils, Strings, typinfo,
VpConst, VpMisc, VpSR; VpConst, VpMisc, VpSR;
const const
@ -235,7 +234,7 @@ var
i, j: Integer; i, j: Integer;
node, prevnode: TDOMNode; node, prevnode: TDOMNode;
rootnode: TDOMNode; rootnode: TDOMNode;
nodename: String; {%H-}nodename: String;
begin begin
L := TStringList.Create; L := TStringList.Create;
try try
@ -368,6 +367,7 @@ end;
function TVpXmlDatastore.GetNextID(TableName: string): Integer; function TVpXmlDatastore.GetNextID(TableName: string): Integer;
begin begin
Unused(TableName);
repeat repeat
Result := Random(High(Integer)); Result := Random(High(Integer));
until UniqueID(Result) and (Result <> -1); until UniqueID(Result) and (Result <> -1);
@ -517,7 +517,7 @@ end;
procedure TVpXmlDatastore.ReadFromXml; procedure TVpXmlDatastore.ReadFromXml;
var var
doc: TXMLDocument; doc: TXMLDocument;
node, child, storeNode: TDOMNode; node, storeNode: TDOMNode;
nodename: String; nodename: String;
begin begin
if FFileName = '' then if FFileName = '' then
@ -538,7 +538,7 @@ begin
while node <> nil do begin while node <> nil do begin
nodeName := node.NodeName; nodeName := node.NodeName;
if nodeName = 'Resources' then if nodeName = 'Resources' then
ReadResources(doc, node); ReadResources(node);
node := node.NextSibling; node := node.NextSibling;
end; end;
finally finally
@ -639,8 +639,7 @@ begin
end; end;
end; end;
procedure TVpXmlDatastore.ReadContacts(ADoc: TDOMDocument; ANode: TDOMNode; procedure TVpXmlDatastore.ReadContacts(ANode: TDOMNode; AContacts: TVpContacts);
AContacts: TVpContacts);
var var
node: TDOMNode; node: TDOMNode;
nodeName: String; nodeName: String;
@ -737,8 +736,7 @@ begin
end; end;
end; end;
procedure TVpXmlDatastore.ReadEvents(ADoc: TDOMDocument; ANode: TDOMNode; procedure TVpXmlDatastore.ReadEvents(ANode: TDOMNode; ASchedule: TVpSchedule);
ASchedule: TVpSchedule);
var var
node: TDOMNode; node: TDOMNode;
nodeName: String; nodeName: String;
@ -755,7 +753,7 @@ end;
// <Resource ResourceID="1178568021" ResourceActive="true"> // <Resource ResourceID="1178568021" ResourceActive="true">
// <Description>some test</Description> // <Description>some test</Description>
// </Resource> // </Resource>
procedure TVpXmlDatastore.ReadResource(ADoc: TDOMDocument; ANode: TDOMNode); procedure TVpXmlDatastore.ReadResource(ANode: TDOMNode);
var var
node: TDOMNode; node: TDOMNode;
nodeName: String; nodeName: String;
@ -780,11 +778,11 @@ begin
else if nodeName = 'Notes' then else if nodeName = 'Notes' then
res.Notes := GetNodeValue(node) res.Notes := GetNodeValue(node)
else if nodeName = 'Contacts' then else if nodeName = 'Contacts' then
ReadContacts(ADoc, node, res.Contacts) ReadContacts(node, res.Contacts)
else if nodeName = 'Events' then else if nodeName = 'Events' then
ReadEvents(ADoc, node, res.Schedule) ReadEvents(node, res.Schedule)
else if nodeName = 'Tasks' then else if nodeName = 'Tasks' then
ReadTasks(ADoc, node, res.Tasks) ReadTasks(node, res.Tasks)
else if nodeName = 'UserField0' then else if nodeName = 'UserField0' then
res.UserField0 := GetNodeValue(node) res.UserField0 := GetNodeValue(node)
else if nodeName = 'UserField1' then else if nodeName = 'UserField1' then
@ -809,7 +807,7 @@ begin
end; end;
end; end;
procedure TVpXmlDatastore.ReadResources(ADoc: TDOMDocument; ANode: TDOMNode); procedure TVpXmlDatastore.ReadResources(ANode: TDOMNode);
var var
node: TDOMNode; node: TDOMNode;
nodeName: String; nodeName: String;
@ -818,7 +816,7 @@ begin
while node <> nil do begin while node <> nil do begin
nodeName := node.NodeName; nodeName := node.NodeName;
if nodeName = 'Resource' then if nodeName = 'Resource' then
ReadResource(ADoc, node); ReadResource(node);
node := node.NextSibling; node := node.NextSibling;
end; end;
end; end;
@ -876,8 +874,7 @@ begin
end; end;
end; end;
procedure TVpXmlDatastore.ReadTasks(ADoc: TDOMDocument; ANode: TDOMNode; procedure TVpXmlDatastore.ReadTasks(ANode: TDOMNode; ATasks: TVpTasks);
ATasks: TVpTasks);
var var
node: TDOMNode; node: TDOMNode;
nodeName: String; nodeName: String;
@ -1280,7 +1277,7 @@ procedure TVpXmlDatastore.WriteEvents(ADoc: TDOMDocument; AParentNode: TDOMNode;
AResource: TVpResource); AResource: TVpResource);
var var
i: Integer; i: Integer;
node, evNode, child, txt: TDOMNode; node, evNode: TDOMNode;
ev: TVpEvent; ev: TVpEvent;
begin begin
node := ADoc.CreateElement('Events'); node := ADoc.CreateElement('Events');
@ -1511,7 +1508,7 @@ procedure TVpXmlDatastore.WriteTasks(ADoc: TDOMDocument; AParentNode: TDOMNode;
AResource: TVpResource); AResource: TVpResource);
var var
i: Integer; i: Integer;
node, tnode, child, txt: TDOMNode; node, tnode: TDOMNode;
t: TVpTask; t: TVpTask;
begin begin
node := ADoc.CreateElement('Tasks'); node := ADoc.CreateElement('Tasks');