You've already forked lazarus-ccr
20070107 release of Orpheus - initial commit to SVN.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
373
components/orpheus/ovctgres.pas
Normal file
373
components/orpheus/ovctgres.pas
Normal file
@ -0,0 +1,373 @@
|
||||
{*********************************************************}
|
||||
{* OVCTGRES.PAS 4.06 *}
|
||||
{*********************************************************}
|
||||
|
||||
{* ***** BEGIN LICENSE BLOCK ***** *}
|
||||
{* Version: MPL 1.1 *}
|
||||
{* *}
|
||||
{* The contents of this file are subject to the Mozilla Public License *}
|
||||
{* Version 1.1 (the "License"); you may not use this file except in *}
|
||||
{* compliance with the License. You may obtain a copy of the License at *}
|
||||
{* http://www.mozilla.org/MPL/ *}
|
||||
{* *}
|
||||
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
||||
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
||||
{* for the specific language governing rights and limitations under the *}
|
||||
{* License. *}
|
||||
{* *}
|
||||
{* The Original Code is TurboPower Orpheus *}
|
||||
{* *}
|
||||
{* The Initial Developer of the Original Code is TurboPower Software *}
|
||||
{* *}
|
||||
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
||||
{* TurboPower Software Inc. All Rights Reserved. *}
|
||||
{* *}
|
||||
{* Contributor(s): *}
|
||||
{* *}
|
||||
{* ***** END LICENSE BLOCK ***** *}
|
||||
|
||||
{$I OVC.INC}
|
||||
|
||||
{$B-} {Complete Boolean Evaluation}
|
||||
{$I+} {Input/Output-Checking}
|
||||
{$P+} {Open Parameters}
|
||||
{$T-} {Typed @ Operator}
|
||||
{.W-} {Windows Stack Frame}
|
||||
{$X+} {Extended Syntax}
|
||||
|
||||
unit ovctgres;
|
||||
{-Orpheus glyph resource manager}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
|
||||
SysUtils, Classes, Graphics, OvcMisc;
|
||||
|
||||
type
|
||||
TOvcCellGlyphs = class(TPersistent)
|
||||
protected {private}
|
||||
{.Z+}
|
||||
FResource : pointer;
|
||||
FActiveGlyphCount : Integer;
|
||||
FGlyphCount : Integer;
|
||||
FOnCfgChanged : TNotifyEvent;
|
||||
{.Z-}
|
||||
protected
|
||||
{.Z+}
|
||||
function GetBitMap : TBitMap;
|
||||
function GetIsDefault : boolean;
|
||||
procedure SetActiveGlyphCount(G : Integer);
|
||||
procedure SetBitMap(BM : TBitMap);
|
||||
procedure SetGlyphCount(G : Integer);
|
||||
procedure SetIsDefault(D : boolean);
|
||||
|
||||
procedure CalcGlyphCount;
|
||||
function IsNotDefault : boolean;
|
||||
procedure DoCfgChanged;
|
||||
{.Z-}
|
||||
public {protected}
|
||||
{.Z+}
|
||||
property OnCfgChanged : TNotifyEvent
|
||||
read FOnCfgChanged write FOnCfgChanged;
|
||||
{.Z-}
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Assign(Source : TPersistent); override;
|
||||
|
||||
published
|
||||
{Note: must be in this order--IsDefault, BitMap, GlyphCount, ActiveGlyphCount}
|
||||
property IsDefault : boolean
|
||||
read GetIsDefault write SetIsDefault
|
||||
stored true;
|
||||
|
||||
property BitMap : TBitMap
|
||||
read GetBitMap write SetBitMap
|
||||
stored IsNotDefault;
|
||||
|
||||
property GlyphCount : Integer
|
||||
read FGlyphCount write SetGlyphCount;
|
||||
|
||||
property ActiveGlyphCount : Integer
|
||||
read FActiveGlyphCount write SetActiveGlyphCount;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
type
|
||||
PCellGlyphResource = ^TCellGlyphResource;
|
||||
TCellGlyphResource = packed record
|
||||
BitMap : TBitMap;
|
||||
ResourceCount : Integer;
|
||||
Next : PCellGlyphResource;
|
||||
end;
|
||||
|
||||
TGlyphResourceManager = class
|
||||
private
|
||||
FList : PCellGlyphResource;
|
||||
DefRes : PCellGlyphResource;
|
||||
protected
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
|
||||
function AllocResource(BM : TBitMap) : PCellGlyphResource;
|
||||
procedure FreeResource(CBGR : PCellGlyphResource);
|
||||
function ReallocResource(ToCBGR, FromCBGR : PCellGlyphResource) : PCellGlyphResource;
|
||||
function DefaultResource : PCellGlyphResource;
|
||||
end;
|
||||
|
||||
var
|
||||
CBResMgr : TGlyphResourceManager;
|
||||
|
||||
function CreateNewResource : PCellGlyphResource;
|
||||
var
|
||||
Size : Integer;
|
||||
begin
|
||||
Size := sizeof(TCellGlyphResource);
|
||||
GetMem(Result, Size);
|
||||
FillChar(Result^, Size, 0);
|
||||
with Result^ do
|
||||
begin
|
||||
ResourceCount := 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DestroyResource(ARes : PCellGlyphResource);
|
||||
begin
|
||||
FreeMem(ARes, sizeof(TCellGlyphResource));
|
||||
end;
|
||||
|
||||
{===TGlyphResourceManager=========================================}
|
||||
constructor TGlyphResourceManager.Create;
|
||||
begin
|
||||
DefRes := CreateNewResource;
|
||||
with DefRes^ do
|
||||
begin
|
||||
BitMap := TBitMap.Create;
|
||||
{$IFNDEF LCL}
|
||||
BitMap.Handle := LoadBaseBitmap('ORTCCHECKGLYPHS');
|
||||
{$ELSE}
|
||||
BitMap.LoadFromLazarusResource('ORTCCHECKGLYPHS');
|
||||
{$ENDIF}
|
||||
end;
|
||||
FList := DefRes;
|
||||
end;
|
||||
{--------}
|
||||
destructor TGlyphResourceManager.Destroy;
|
||||
var
|
||||
Temp : PCellGlyphResource;
|
||||
begin
|
||||
while Assigned(FList) do
|
||||
begin
|
||||
Temp := FList;
|
||||
FList := Temp^.Next;
|
||||
Temp^.BitMap.Free;
|
||||
DestroyResource(Temp);
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
function TGlyphResourceManager.AllocResource(BM : TBitMap) : PCellGlyphResource;
|
||||
var
|
||||
NewRes : PCellGlyphResource;
|
||||
begin
|
||||
NewRes := CreateNewResource;
|
||||
with NewRes^ do
|
||||
begin
|
||||
BitMap := TBitMap.Create;
|
||||
BitMap.Assign(BM);
|
||||
Next := FList;
|
||||
end;
|
||||
FList := NewRes;
|
||||
Result := NewRes;
|
||||
end;
|
||||
{--------}
|
||||
procedure TGlyphResourceManager.FreeResource(CBGR : PCellGlyphResource);
|
||||
var
|
||||
Temp, Dad : PCellGlyphResource;
|
||||
begin
|
||||
Temp := FList;
|
||||
Dad := nil;
|
||||
while (Temp <> nil) do
|
||||
if (Temp = CBGR) then
|
||||
begin
|
||||
dec(Temp^.ResourceCount);
|
||||
if (Temp^.ResourceCount = 0) then
|
||||
begin
|
||||
with Temp^ do
|
||||
begin
|
||||
if (Dad = nil) then
|
||||
FList := Next
|
||||
else Dad^.Next := Next;
|
||||
BitMap.Free;
|
||||
end;
|
||||
DestroyResource(Temp);
|
||||
end;
|
||||
Temp := nil; {get out of loop}
|
||||
end
|
||||
else
|
||||
begin
|
||||
Dad := Temp;
|
||||
Temp := Temp^.Next;
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
function TGlyphResourceManager.ReallocResource(ToCBGR, FromCBGR : PCellGlyphResource)
|
||||
: PCellGlyphResource;
|
||||
var
|
||||
Temp : PCellGlyphResource;
|
||||
begin
|
||||
FreeResource(FromCBGR);
|
||||
Temp := FList;
|
||||
while (Temp <> nil) do
|
||||
if (Temp = ToCBGR) then
|
||||
begin
|
||||
inc(Temp^.ResourceCount);
|
||||
Result := Temp;
|
||||
Exit;
|
||||
end
|
||||
else
|
||||
Temp := Temp^.Next;
|
||||
Result := DefaultResource;
|
||||
end;
|
||||
{--------}
|
||||
function TGlyphResourceManager.DefaultResource : PCellGlyphResource;
|
||||
begin
|
||||
inc(DefRes^.ResourceCount);
|
||||
Result := DefRes;
|
||||
end;
|
||||
{====================================================================}
|
||||
|
||||
{===TOvcCellGlyphs==================================================}
|
||||
constructor TOvcCellGlyphs.Create;
|
||||
begin
|
||||
FResource := CBResMgr.DefaultResource;
|
||||
CalcGlyphCount;
|
||||
end;
|
||||
{--------}
|
||||
destructor TOvcCellGlyphs.Destroy;
|
||||
begin
|
||||
CBResMgr.FreeResource(PCellGlyphResource(FResource));
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcCellGlyphs.Assign(Source : TPersistent);
|
||||
begin
|
||||
if Source is TOvcCellGlyphs then begin
|
||||
if (Source = nil) then
|
||||
begin
|
||||
CBResMgr.FreeResource(PCellGlyphResource(FResource));
|
||||
FResource := CBResMgr.DefaultResource;
|
||||
end
|
||||
else if (FResource <> TOvcCellGlyphs(Source).FResource) then
|
||||
FResource :=
|
||||
CBResMgr.ReallocResource(PCellGlyphResource(TOvcCellGlyphs(Source).FResource),
|
||||
PCellGlyphResource(FResource));
|
||||
CalcGlyphCount;
|
||||
DoCfgChanged
|
||||
end else inherited Assign(Source);
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcCellGlyphs.CalcGlyphCount;
|
||||
var
|
||||
Temp : Integer;
|
||||
begin
|
||||
FGlyphCount := 1;
|
||||
FActiveGlyphCount := 1;
|
||||
with BitMap do
|
||||
begin
|
||||
if (Height > 0) then
|
||||
begin
|
||||
Temp := Width div Height;
|
||||
if ((Temp * Height) = Width) then
|
||||
begin
|
||||
FGlyphCount := Temp;
|
||||
FActiveGlyphCount := Temp;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
function TOvcCellGlyphs.GetBitMap : TBitMap;
|
||||
begin
|
||||
with PCellGlyphResource(FResource)^ do
|
||||
Result := Bitmap;
|
||||
end;
|
||||
{--------}
|
||||
function TOvcCellGlyphs.GetIsDefault : boolean;
|
||||
begin
|
||||
Result := FResource = pointer(CBResMgr.DefRes);
|
||||
end;
|
||||
{--------}
|
||||
function TOvcCellGlyphs.IsNotDefault : boolean;
|
||||
begin
|
||||
Result := not IsDefault;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcCellGlyphs.DoCfgChanged;
|
||||
begin
|
||||
if Assigned(FOnCfgChanged) then
|
||||
FOnCfgChanged(Self);
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcCellGlyphs.SetActiveGlyphCount(G : Integer);
|
||||
begin
|
||||
if (G <> FActiveGlyphCount) and
|
||||
(1 <= G) and (G <= GlyphCount)then
|
||||
begin
|
||||
FActiveGlyphCount := G;
|
||||
DoCfgChanged;
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcCellGlyphs.SetBitMap(BM : TBitMap);
|
||||
begin
|
||||
CBResMgr.FreeResource(PCellGlyphResource(FResource));
|
||||
if (BM = nil) then
|
||||
FResource := CBResMgr.DefaultResource
|
||||
else
|
||||
FResource := CBResMgr.AllocResource(BM);
|
||||
CalcGlyphCount;
|
||||
DoCfgChanged;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcCellGlyphs.SetGlyphCount(G : Integer);
|
||||
begin
|
||||
if (G <> FGlyphCount) then
|
||||
begin
|
||||
FGlyphCount := G;
|
||||
FActiveGlyphCount := G;
|
||||
DoCfgChanged;
|
||||
end;
|
||||
end;
|
||||
{--------}
|
||||
procedure TOvcCellGlyphs.SetIsDefault(D : boolean);
|
||||
begin
|
||||
if (D <> IsDefault) then
|
||||
begin
|
||||
if D then
|
||||
Assign(nil)
|
||||
else
|
||||
BitMap := BitMap; {note: this actually does do something!}
|
||||
CalcGlyphCount;
|
||||
DoCfgChanged;
|
||||
end;
|
||||
end;
|
||||
{====================================================================}
|
||||
|
||||
|
||||
procedure DestroyManager; far;
|
||||
begin
|
||||
CBResMgr.Free;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
CBResMgr := TGlyphResourceManager.Create;
|
||||
|
||||
finalization
|
||||
DestroyManager;
|
||||
end.
|
||||
Reference in New Issue
Block a user