From 8a0f7d6cbc1f7fecebaa680fee764f0140e10d04 Mon Sep 17 00:00:00 2001 From: lazarus Date: Sun, 18 Aug 2002 04:56:45 +0000 Subject: [PATCH] MG: added DrawItem to TComboBox/TListBox git-svn-id: trunk@2685 - --- .gitattributes | 1 + lcl/extendedstrings.pas | 206 ++++++++++++++++++++++++++++++++++++++++ lcl/include/canvas.inc | 5 +- 3 files changed, 211 insertions(+), 1 deletion(-) create mode 100644 lcl/extendedstrings.pas diff --git a/.gitattributes b/.gitattributes index 31d3b3f60b..70034173e2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -507,6 +507,7 @@ lcl/controls.pp svneol=native#text/pascal lcl/dialogs.pp svneol=native#text/pascal lcl/dynhasharray.pp svneol=native#text/pascal lcl/extctrls.pp svneol=native#text/pascal +lcl/extendedstrings.pas svneol=native#text/pascal lcl/filectrl.pp svneol=native#text/pascal lcl/forms.pp svneol=native#text/pascal lcl/graphics.pp svneol=native#text/pascal diff --git a/lcl/extendedstrings.pas b/lcl/extendedstrings.pas new file mode 100644 index 0000000000..954d6d8209 --- /dev/null +++ b/lcl/extendedstrings.pas @@ -0,0 +1,206 @@ +{ + /*************************************************************************** + extendedstrings.pas + ------------------- + + ***************************************************************************/ + + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.LCL, included in this distribution, * + * for details about the copyright. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * + * * + ***************************************************************************** + + Author: Mattias: Gaertner + + TExtendedStrings is a normal TStringList, except that the Objects are extended + to records. +} +unit ExtendedStrings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TExtStringsOption = ( + esoClearRecordsOnCreate, + esoFreeObjectsOnDelete + ); + TExtStringsOptions = set of TExtStringsOption; + + TExtendedStringList = class(TStringList) + private + FOptions: TExtStringsOptions; + FRecordSize: integer; + function GetRecords(Index: integer): pointer; + procedure SetOptions(const AValue: TExtStringsOptions); + procedure SetRecords(Index: integer; const AValue: pointer); + procedure SetRecordSize(const AValue: integer); + procedure DoResizeRecord(Index, OldSize, NewSize: integer); + protected + procedure ResizeRecord(var ARecord: Pointer; + Index, OldSize, NewSize: integer); virtual; + function GetObject(Index: Integer): TObject; override; + procedure PutObject(Index: Integer; AnObject: TObject); override; + public + constructor Create(InitialRecordSize: integer); + destructor Destroy; override; + procedure Clear; override; + procedure Delete(Index: Integer); override; + procedure CreateRecord(Index: integer); virtual; + procedure FreeRecord(Index: integer); virtual; + procedure FreeAllRecords; virtual; + function RecordAllocated(Index: integer): boolean; + property Records[Index: integer]: pointer read GetRecords write SetRecords; + property RecordSize: integer read FRecordSize write SetRecordSize; + property Options: TExtStringsOptions read FOptions write SetOptions; + end; + +implementation + +{ TExtendedStringList } + +function TExtendedStringList.GetRecords(Index: integer): pointer; +begin + if not RecordAllocated(Index) then CreateRecord(Index); + Result:=inherited GetObject(Index); +end; + +procedure TExtendedStringList.SetOptions(const AValue: TExtStringsOptions); +begin + if FOptions=AValue then exit; + FOptions:=AValue; +end; + +procedure TExtendedStringList.SetRecords(Index: integer; const AValue: pointer); +begin + FreeRecord(Index); + inherited PutObject(Index,TObject(AValue)); +end; + +procedure TExtendedStringList.SetRecordSize(const AValue: integer); +var + i: integer; +begin + if FRecordSize=AValue then exit; + for i:=0 to Count-1 do + DoResizeRecord(i,FRecordSize,AValue); + FRecordSize:=AValue; +end; + +procedure TExtendedStringList.DoResizeRecord(Index, OldSize, NewSize: integer); +var + CurRecord: Pointer; +begin + CurRecord:=inherited GetObject(Index); + if CurRecord=nil then exit; + ResizeRecord(CurRecord,Index,OldSize,NewSize); + inherited PutObject(Index,TObject(CurRecord)); +end; + +procedure TExtendedStringList.CreateRecord(Index: integer); +var + NewRecord: Pointer; +begin + GetMem(NewRecord,RecordSize); + if (esoClearRecordsOnCreate in Options) then + FillChar(NewRecord^,RecordSize,0); + inherited PutObject(Index,TObject(NewRecord)); +end; + +procedure TExtendedStringList.FreeRecord(Index: integer); +var + OldRecord: pointer; + OldObject: TObject; +begin + OldRecord:=inherited GetObject(Index); + if OldRecord<>nil then begin + if (esoFreeObjectsOnDelete in Options) then begin + OldObject:=Objects[Index]; + if OldObject<>nil then begin + OldObject.Free; + end; + end; + FreeMem(OldRecord); + inherited PutObject(Index,nil); + end; +end; + +procedure TExtendedStringList.FreeAllRecords; +var + i: integer; +begin + for i:=0 to Count-1 do + FreeRecord(i); +end; + +function TExtendedStringList.RecordAllocated(Index: integer): boolean; +begin + Result:=(inherited GetObject(Index))<>nil; +end; + +procedure TExtendedStringList.ResizeRecord(var ARecord: Pointer; Index, OldSize, + NewSize: integer); +begin + ReAllocMem(ARecord,NewSize); +end; + +function TExtendedStringList.GetObject(Index: Integer): TObject; +var + ARecord: Pointer; +begin + ARecord:=inherited GetObject(Index); + if ARecord<>nil then + Result:=TObject(ARecord^) + else + Result:=nil; +end; + +procedure TExtendedStringList.PutObject(Index: Integer; AnObject: TObject); +var + ARecord: Pointer; +begin + ARecord:=Records[Index]; + if ARecord=nil then + CreateRecord(Index); + TObject(ARecord^):=AnObject; +end; + +constructor TExtendedStringList.Create(InitialRecordSize: integer); +begin + inherited Create; + FOptions:=[esoClearRecordsOnCreate]; + FRecordSize:=InitialRecordSize; +end; + +destructor TExtendedStringList.Destroy; +begin + FreeAllRecords; + inherited Destroy; +end; + +procedure TExtendedStringList.Clear; +begin + FreeAllRecords; + inherited Clear; +end; + +procedure TExtendedStringList.Delete(Index: Integer); +begin + FreeRecord(Index); + inherited Delete(Index); +end; + +end. + diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc index 44dcf5b506..5d176d4397 100644 --- a/lcl/include/canvas.inc +++ b/lcl/include/canvas.inc @@ -570,7 +570,7 @@ end; ------------------------------------------------------------------------------} procedure TCanvas.Rectangle(const Rect: TRect); begin - Rectangle(Rect.Left, REct.Top, Rect.RIght, REct.Bottom); + Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); end; {------------------------------------------------------------------------------ @@ -1104,6 +1104,9 @@ end; { ============================================================================= $Log$ + Revision 1.30 2002/10/04 14:24:14 lazarus + MG: added DrawItem to TComboBox/TListBox + Revision 1.29 2002/09/27 20:52:22 lazarus MWE: Applied patch from "Andrew Johnson"